home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 1990-10-25 | 115.5 KB | 4,462 lines | [ TEXT/MPS ]
{$P} {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]} { UMacApp.TApplication.p } { Copyright © 1984-1990 by Apple Computer Inc. All rights reserved. } {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TCommandList.Compare(item1, item2: TObject): integer; BEGIN IF TCommand(item1).fPriority > TCommand(item2).fPriority THEN Compare := kItem1GreaterThanItem2 ELSE IF TCommand(item1).fPriority < TCommand(item2).fPriority THEN Compare := kItem1LessThanItem2 ELSE Compare := kItem1EqualItem2 END; {--------------------------------------------------------------------------------------------------} {$S MAInit} PROCEDURE TCommandList.ICommandList; BEGIN ISortedList; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TCommandList.Insert(item: TObject); OVERRIDE; VAR oldObjectPerm: BOOLEAN; anEqualItem: ArrayIndex; lastEqualItem: ArrayIndex; i: ArrayIndex; BEGIN { Guarantee that the insertion can take place } oldObjectPerm := AllocateObjectsFromPerm(FALSE); { !!! the search alg. should support this. Performance will degrade here for big queues (shouldn't happen often, but come back and fix the general case anyways) } anEqualItem := GetEqualItemNo(item); { If any equal items were found then find the _last_ equal item } IF anEqualItem <> kEmptyIndex THEN BEGIN lastEqualItem := anEqualItem; { Tentative value } FOR i := (anEqualItem + 1) TO GetSize DO { ??? what about kMaxArrayIndex? } IF Compare(At(i), item) = kItem1EqualItem2 THEN lastEqualItem := i ELSE LEAVE; InsertBefore(lastEqualItem + 1, item); END ELSE INHERITED Insert(item); IF AllocateObjectsFromPerm(oldObjectPerm) THEN; END; {--------------------------------------------------------------------------------------------------} {$S MAFields} PROCEDURE TCommandList.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TCommandList', NIL, bClass); INHERITED Fields(DoToField); END; {--------------------------------------------------------------------------------------------------} {$IFC qDebug} {$S MADebugger} PROCEDURE TDebugCommand.DoIt; BEGIN EnterMacAppDebugger; END; {$ENDC} {--------------------------------------------------------------------------------------------------} {$IFC qDebug} {$S MASelCommand} PROCEDURE TDebugCommand.IDebugCommand(itsCmdNumber: CmdNumber); BEGIN INoChangesCommand(itsCmdNumber, NIL, NIL, NIL); END; {$ENDC} {--------------------------------------------------------------------------------------------------} {$IFC qDebug} {$S MAFields} PROCEDURE TDebugCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TDebugCommand', NIL, bClass); INHERITED Fields(DoToField); END; {$ENDC} {--------------------------------------------------------------------------------------------------} {$IFC qInspector} {$S MAInspector} PROCEDURE TInspectorCommand.DoIt; BEGIN MakeInspectorWindow; END; {$ENDC} {--------------------------------------------------------------------------------------------------} {$IFC qInspector} {$S MASelCommand} PROCEDURE TInspectorCommand.IInspectorCommand(itsCmdNumber: CmdNumber); BEGIN INoChangesCommand(itsCmdNumber, NIL, NIL, NIL); END; {$ENDC} {--------------------------------------------------------------------------------------------------} {$IFC qInspector} {$S MAFields} PROCEDURE TInspectorCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TInspectorCommand', NIL, bClass); INHERITED Fields(DoToField); END; {$ENDC} {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TQuitCommand.DoIt; VAR fi: FailInfo; PROCEDURE HdlQuit(error: OSErr; message: LONGINT); BEGIN gAppDone := FALSE; END; BEGIN CatchFailures(fi, HdlQuit); gAppDone := TRUE; gApplication.Close; Success(fi); END; {--------------------------------------------------------------------------------------------------} {$S MAInit} PROCEDURE TQuitCommand.IQuitCommand(itsCmdNumber: CmdNumber); BEGIN INoChangesCommand(itsCmdNumber, NIL, NIL, NIL); END; {--------------------------------------------------------------------------------------------------} {$S MAFields} PROCEDURE TQuitCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TQuitCommand', NIL, bClass); INHERITED Fields(DoToField); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TUndoRedoCommand.DoIt; VAR deltaCount: integer; lastCommand: TCommand; BEGIN lastCommand := gTarget.GetLastCommand; IF lastCommand.fChangesClipboard THEN gApplication.SwapClipViews; IF lastCommand.fCmdDone THEN BEGIN lastCommand.UndoIt; deltaCount := - 1; END ELSE BEGIN lastCommand.RedoIt; deltaCount := 1; END; lastCommand.fCmdDone := NOT lastCommand.fCmdDone; IF lastCommand.fCausesChange THEN { put this after .UndoIt/.RedoIt, so they can change the flag } WITH lastCommand DO IF fChangedDocument <> NIL THEN WITH fChangedDocument DO BEGIN SetChangeCount(GetChangeCount + deltaCount); {$IFC qDebug} IF GetChangeCount < 0 THEN ProgramBreak('GetChangeCount < 0'); {$ENDC} END; END; {--------------------------------------------------------------------------------------------------} {$S MAInit} PROCEDURE TUndoRedoCommand.IUndoRedoCommand(itsCmdNumber: CmdNumber); BEGIN INoChangesCommand(itsCmdNumber, NIL, NIL, NIL); END; {--------------------------------------------------------------------------------------------------} {$S MAFields} PROCEDURE TUndoRedoCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TUndoRedoCommand', NIL, bClass); INHERITED Fields(DoToField); END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} PROCEDURE TNewDocCommand.DoIt; BEGIN gApplication.OpenNew(fCmdNumber); END; {--------------------------------------------------------------------------------------------------} {$S MASelCommand} PROCEDURE TNewDocCommand.INewDocCommand(itsCmdNumber: CmdNumber); BEGIN INoChangesCommand(itsCmdNumber, NIL, NIL, NIL); END; {--------------------------------------------------------------------------------------------------} {$S MAFields} PROCEDURE TNewDocCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TNewDocCommand', NIL, bClass); INHERITED Fields(DoToField); END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} PROCEDURE TOldDocCommand.DoIt; VAR anAppFile: AppFile; BEGIN IF gApplication.ChooseDocument(fCmdNumber, anAppFile) THEN gApplication.OpenOld(fCmdNumber, anAppFile); END; {--------------------------------------------------------------------------------------------------} {$S MASelCommand} PROCEDURE TOldDocCommand.IOldDocCommand(itsCmdNumber: CmdNumber); BEGIN INoChangesCommand(itsCmdNumber, NIL, NIL, NIL); END; {--------------------------------------------------------------------------------------------------} {$S MAFields} PROCEDURE TOldDocCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TOldDocCommand', NIL, bClass); INHERITED Fields(DoToField); END; {--------------------------------------------------------------------------------------------------} {$S MASelCommand} PROCEDURE TAboutAppCommand.IAboutAppCommand(itsCmdNumber: CmdNumber); BEGIN INoChangesCommand(itsCmdNumber, NIL, NIL, NIL); END; {--------------------------------------------------------------------------------------------------} {$S MAAboutApp} PROCEDURE TAboutAppCommand.DoIt; BEGIN gApplication.DoShowAboutApp; END; {--------------------------------------------------------------------------------------------------} {$S MAFields} PROCEDURE TAboutAppCommand.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TAboutAppCommand', NIL, bClass); INHERITED Fields(DoToField); END; {--------------------------------------------------------------------------------------------------} {$S MAInit} PROCEDURE TApplication.IApplication(itsMainFileType: OSType); CONST kParamText1 = '^0'; TYPE MenuBarHandle = ^MenuBarPtr; MenuBarPtr = ^MenuBarRecord; MenuBarRecord = RECORD nMenus: integer; menuID: ARRAY [1..1000] OF integer; END; VAR menuID: integer; aMenu: MenuHandle; mbar: Handle; hmbar: MenuBarHandle; i: integer; s: Str255; aCommandList: TCommandList; apName: Str255; apRefnum: integer; apParam: Handle; BEGIN gApplication := SELF; gAppDone := FALSE; gSysWindowActive := FALSE; gTarget := SELF; fTicksOfLastIdle := 0; fTicksTilNextIdle := 0; fCommandQueue := NIL; fLastCommand := NIL; WITH gOldScrapStuff DO BEGIN scrapSize := 0; scrapHandle := NIL; scrapCount := 0; scrapState := 0; scrapName := NIL; END; gNewScrapStuff := gOldScrapStuff; IEvtHandler(NIL); {$IFC qInspector} MakeInspector; AddObjectToInspector(SELF); AddObjectToInspector(gNullPrintHandler); AddObjectToInspector(gPrintHandler); AddObjectToInspector(gFreeWindowList); {$ENDC} New(aCommandList); FailNil(aCommandList); aCommandList.ICommandList; fCommandQueue := aCommandList; {$IFC qDebug} fCommandQueue.SetEltType('TCommand'); {$ENDC} fLaunchWithNewDocument := TRUE; gDocList := NewList; {$IFC qDebug} gDocList.SetEltType('TDocument'); {$ENDC} gMainFileType := itsMainFileType; gVarClipPicSize := FALSE; { temporary } IF NOT gFinderPrinting THEN BEGIN mbar := MAGetNewMBar(gMBarDisplayed); IF mbar <> NIL THEN BEGIN SetMenuBar(mbar); ReleaseResource(Handle(mbar)); END ELSE BEGIN {$IFC qDebug} Writeln('The MBAR ', gMBarDisplayed: 1, ' resource was not specified.'); ProgramBreak('You will not have any menus!'); {$ENDC} END; {$IFC qDebug OR qInspector} aMenu := GetMenu(mDebug); IF aMenu <> NIL THEN InsertMenu(aMenu, 0); {$ENDC} aMenu := MAGetMenu(mApple); IF aMenu <> NIL THEN AddResMenu(aMenu, 'DRVR'); { If the "About" item contains the paramtext keystring (^0) then substitute the Application's name } CmdToName(cAboutApp, s); i := Pos(kParamText1, s); IF i <> 0 THEN BEGIN GetAppParms(apName, apRefnum, apParam); Delete(s, i, length(kParamText1)); Insert(apName, s, i); SetCmdName(cAboutApp, s); END; mbar := MAGetNewMBar(gMBarNotDisplayed); { reads in and initializes these menus. } IF mbar <> NIL THEN ReleaseResource(Handle(mbar)); IF qNeedsHierarchicalMenus | gConfiguration.hasHierarchicalMenus THEN BEGIN { Add all the hierarchical menus in the 'hierarchical' menu bar to the applications menus. Note that hierarchical must be treated differently from regular menus in that they are added with InsertMenu(…, -1). We can't use GetNewMBar here because we want to call GetMenu for each menu in the MBAR, and GetNewMBar would do that for us.} hmbar := MenuBarHandle(GetResource('MBAR', gMBarHierarchical)); IF hmbar <> NIL THEN BEGIN FOR i := 1 TO hmbar^^.nMenus DO BEGIN aMenu := GetMenu(hmbar^^.menuID[i]); IF aMenu <> NIL THEN InsertMenu(aMenu, - 1); END; ReleaseResource(Handle(hmbar)); END; END; InvalidateMenuBar; gClipWindow := MakeClipboardWindow; gClipOrphanage := gClipWindow.FindSubView(KIDClipView); FailNILResource(gClipOrphanage); END; { | Finally finish up with the debugger; } {$IFC qDebug} InitUDebugAfterIApplication; {$ENDC} END; {--------------------------------------------------------------------------------------------------} {$S MAClipboard} PROCEDURE TApplication.AbandonUndoClipboard; BEGIN IF gClipUndoView <> NIL THEN BEGIN {$IFC qDebug} IF gClipUndoView = gClipView THEN ProgramBreak('About to Free view both in clip and undo Clip!'); {$ENDC} gClipUndoView.FreeFromClipboard; gClipUndoView := NIL; END; END; {--------------------------------------------------------------------------------------------------} {$S MAActivate} PROCEDURE TApplication.AboutToLoseControl(convertClipboard: BOOLEAN); LABEL 1000; VAR err: LONGINT; fi: FailInfo; lastCommand: TCommand; PROCEDURE PublicizeFailed(error: integer; message: LONGINT); { ??? ERROR ??? } BEGIN {$IFC qDebug} Writeln('Can''t use clipboard data outside this app'); {$ENDC} IF message = 0 THEN message := msgExportClipFailed; ShowError(error, message); GOTO 1000; END; BEGIN { Remember when we last started a desk accessory. UPrinting uses this to know whether the Chooser may have been run. } gLastDeskAcc := TickCount; ActivateBusyCursor(FALSE); { Don't want busy cursor while in desk acc.} IF convertClipboard THEN BEGIN lastCommand := GetLastCommand; IF (lastCommand <> NIL) & lastCommand.fChangesClipboard THEN CommitLastCommand; IF (gClipView <> NIL) & (NOT gClipWrittenToDeskScrap) THEN BEGIN err := ZeroScrap; CatchFailures(fi, PublicizeFailed); gClipView.WriteToDeskScrap; Success(fi); gClipWrittenToDeskScrap := TRUE; 1000: AbsorbScrapStuff; { ??? correct post-error reentry point? } END; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.AbsorbScrapStuff; BEGIN gOldScrapStuff := gNewScrapStuff; { stash previous version, for later change-checkage } gNewScrapStuff := InfoScrap^; { Copy over from low memory to our private global record } END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.ActivateBusyCursor(entering: BOOLEAN); BEGIN BusyActivate(entering); END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} PROCEDURE TApplication.AddDocument(aNewDocument: TDocument); BEGIN gDocList.Insert(aNewDocument); END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} PROCEDURE TApplication.AddFreeWindow(aWindow: TWindow); BEGIN gFreeWindowList.Insert(aWindow); END; {--------------------------------------------------------------------------------------------------} {$S MAFile} FUNCTION TApplication.AlreadyOpen(fileName: Str255; volRefnum: integer): TDocument; CONST ignoreCase = FALSE; diacritSens = TRUE; VAR parmDirID: LONGINT; parmVRefnum: integer; result: TDocument; err: OSErr; PROCEDURE TestDoc(doc: TDocument); VAR err: OSErr; docVRefnum: integer; docDirID: LONGINT; BEGIN IF (result = NIL) & doc.fSaveExists THEN BEGIN docVRefnum := doc.fVolRefnum; err := GetDirID(docVRefnum, docDirID); IF (err = noErr) & (docVRefnum = parmVRefnum) & (docDirID = parmDirID) THEN BEGIN {$Push} {$H-} { EqualString does not move memory } IF EqualString(fileName, doc.fTitle^^, ignoreCase, diacritSens) THEN result := doc; {$Pop} END; END; END; BEGIN result := NIL; parmVRefnum := volRefnum; err := GetDirID(parmVRefnum, parmDirID); IF err = noErr THEN ForAllDocumentsDo(TestDoc); AlreadyOpen := result; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.Beep(duration: integer); BEGIN SysBeep(duration); END; {--------------------------------------------------------------------------------------------------} FUNCTION CallFileFilter(paramBlock: HParmBlkPtr; routine: ProcPtr): BOOLEAN; INLINE $205F, { MOVEA.L (A7)+,A0 } $4E90; { JSR (A0) } { This is called only when opening/printing from the finder; it simulates the filtering done by Std File. } {--------------------------------------------------------------------------------------------------} {$S MAFinder} FUNCTION TApplication.CanOpenDocument(itsCmdNumber: CmdNumber; VAR anAppFile: AppFile): BOOLEAN; VAR dlgID: integer; where: Point; fileFilter: ProcPtr; dlgHook: ProcPtr; filterProc: ProcPtr; typeList: TypeListHandle; i: integer; paramBlock: HParamBlockRec; numTypes: integer; BEGIN CanOpenDocument := FALSE; { First check that file type is in the list of allowed file types. See SFGetParms below for more info. } typeList := TypeListHandle(NewHandle(0)); FailNil(typeList); SFGetParms(itsCmdNumber, dlgID, where, fileFilter, dlgHook, filterProc, typeList); numTypes := GetHandleSize(Handle(typeList)) DIV SIZEOF(ResType); IF numTypes = 0 THEN CanOpenDocument := TRUE { if 0 then want all types } ELSE FOR i := 1 TO numTypes DO { do coercions because the compiler generates lousy code for comparing 2 packed arrays of characters } IF LONGINT(anAppFile.fType) = LONGINT(typeList^^[i]) THEN BEGIN IF fileFilter = NIL THEN CanOpenDocument := TRUE ELSE IF GetFileInfo(anAppFile.fName, anAppFile.vRefnum, paramBlock) = noErr THEN CanOpenDocument := NOT CallFileFilter(@paramBlock, fileFilter) ELSE CanOpenDocument := FALSE; LEAVE; END; Handle(typeList) := DisposeIfHandle(typeList); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.CheckDeskScrap; VAR err: OSErr; lastCommand: TCommand; BEGIN AbsorbScrapStuff; IF (gOldScrapStuff.scrapCount <> gNewScrapStuff.scrapCount) THEN BEGIN lastCommand := GetLastCommand; IF (lastCommand <> NIL) & lastCommand.fChangesClipboard THEN CommitLastCommand; gClipView.FreeFromClipboard; { AbandonCurrentClipboard } gClipView := NIL; { no reason to have an Undo clipboard } { If the scrap is in memory and we are low on memory, then write the scrap to disk.} IF (gNewScrapStuff.scrapState > 0) & MemSpaceIsLow THEN err := UnloadScrap; { Write the scrap to disk. How should we handle the error??? } ReadFromDeskScrap; END; END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} FUNCTION TApplication.ChooseDocument(itsCmdNumber: CmdNumber; VAR anAppFile: AppFile): BOOLEAN; TYPE SFTypeListHandle = ^SFTypeListPtr; SFTypeListPtr = ^SFTypeList; VAR dlgID: integer; where: Point; fileFilter: ProcPtr; dlgHook: ProcPtr; filterProc: ProcPtr; typeList: TypeListHandle; pTypeList: SFTypeListPtr; numTypes: integer; reply: SFReply; BEGIN typeList := TypeListHandle(NewHandle(0)); FailNil(typeList); SFGetParms(itsCmdNumber, dlgID, where, fileFilter, dlgHook, filterProc, typeList); numTypes := GetHandleSize(Handle(typeList)) DIV SIZEOF(ResType); IF numTypes = 0 THEN BEGIN numTypes := - 1; { Tell Std File to display all types.} pTypeList := @pTypeList; { arbitrary, as long as it points to 4 bytes of valid memory } END ELSE BEGIN LockHandleHigh(Handle(typeList)); { in case Std File does allocations } pTypeList := SFTypeListHandle(typeList)^; END; {$IFC qDebug} { Causes TApplication.GetEvent to call CheckRsrcUsage. } gRsrcCheck := 0; {$ENDC} UpdateAllWindows; { needed to work around bug in SF; if all windows are not updated you wont be able to mount a disk correctly } SFPGetFile(where, '', fileFilter, numTypes, pTypeList^, dlgHook, reply, dlgID, filterProc); Handle(typeList) := DisposeIfHandle(typeList); ChooseDocument := reply.good; IF reply.good THEN BEGIN anAppFile.vRefnum := reply.vRefnum; anAppFile.fType := reply.fType; anAppFile.versNum := reply.version; anAppFile.fName := reply.fName; END; END; {--------------------------------------------------------------------------------------------------} {$S MAClipboard} PROCEDURE TApplication.ClaimClipboard(clipView: TView); BEGIN AbandonUndoClipboard; { free up any old UNDO stuff } gClipUndoView := gClipView; { Copy current clipboard contents to the Undo side } IF clipView <> NIL THEN SetClipView(clipView) { Will install it as gClipView } ELSE BEGIN {$IFC qDebug} ProgramBreak('Claiming clipboard with null view'); {$ENDC} END; gClipClaimed := TRUE; END; {--------------------------------------------------------------------------------------------------} {$S MATerminate} PROCEDURE TApplication.Close; VAR WMgrWindow: WindowPtr; PROCEDURE FreeIt(anEvtHandler: TEvtHandler); BEGIN FreeIfObject(anEvtHandler); { ??? also call Terminate ??? } anEvtHandler := NIL; END; PROCEDURE CloseADocument(aDocument: TDocument); BEGIN aDocument.Close; END; BEGIN { Close all of the windows } REPEAT WMgrWindow := FrontWindow; IF WMgrWindow <> NIL THEN CloseWMgrWindow(WMgrWindow); UNTIL WMgrWindow = NIL; { Close any windowless documents } ForAllDocumentsDo(CloseADocument); gPrintHandler.Terminate; IF gHeadCoHandler <> NIL THEN gHeadCoHandler.EachHandler(FreeIt); IF LoadScrap <> noErr THEN; { ??? } END; {--------------------------------------------------------------------------------------------------} {$S MAClose} PROCEDURE TApplication.CloseWMgrWindow(aWMgrWindow: WindowPtr); VAR aWindow: TWindow; BEGIN IF IsDeskAccessory(aWMgrWindow) THEN CloseDeskAcc(WindowPeek(aWMgrWindow)^.windowKind) ELSE BEGIN aWindow := WMgrToWindow(aWMgrWindow); IF aWindow <> NIL THEN aWindow.CloseByUser ELSE HideWindow(aWMgrWindow); END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.CommitLastCommand; BEGIN AbandonUndoClipboard; IF fLastCommand <> NIL THEN BEGIN IF fLastCommand.fCmdDone THEN fLastCommand.Commit; IF fLastCommand.fFreeOnCompletion THEN FreeIfObject(fLastCommand); fLastCommand := NIL; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.CountClicks(aPDownEvent: EventRecordPtr; whereMouseDown: integer): integer; VAR clickCount: integer; BEGIN clickCount := 1; WITH aPDownEvent^ DO BEGIN { This series of IF's generates less code than short-circuit booleans } IF whereMouseDown = gLastClickPart THEN IF gClickCount > 0 THEN { not the first click and ... } IF when - gLastUpTime < GetDblTime THEN { ... close enough in time and ... } IF gTarget.DoMultiClick(gLastMsePt, where) { ... close enough in space } THEN clickCount := gClickCount + 1; gLastMsePt := where; END; gLastClickPart := whereMouseDown; gClickCount := clickCount; CountClicks := clickCount; END; {--------------------------------------------------------------------------------------------------} {$S MAClose} PROCEDURE TApplication.DeleteDocument(docToDelete: TDocument); BEGIN gDocList.Delete(docToDelete); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.DeleteFreeWindow(windowToDelete: TWindow); BEGIN gFreeWindowList.Delete(windowToDelete); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.DispatchEvent(VAR theEventInfo: EventInfo; VAR commandToPerform: TCommand); BEGIN commandToPerform := NIL; WITH theEventInfo.thePEvent^ DO BEGIN CASE what OF mouseUp: commandToPerform := HandleMouseUp(theEventInfo); mouseDown: commandToPerform := HandleMouseDown(theEventInfo); activateEvt: commandToPerform := HandleActivateEvent(theEventInfo); updateEvt: commandToPerform := HandleUpdateEvent(theEventInfo); keyDown, autoKey: commandToPerform := HandleKeyDownEvent(theEventInfo); keyUp: { !!! We'd like to have a chain for keyUp but a MultiFinder™ bug (at least up to 6.0) keep us from reliably getting keyUp events after minor context switches (background updates, etc.). It replaces the global event mask (which we would have had to change to get keyups in the first place) with the wrong mask. Oh well, we had such good intentions! } ; diskEvt: commandToPerform := HandleDiskEvent(theEventInfo); app4Evt: { All app4Evt's are owned by the system } commandToPerform := HandleSystemEvent(theEventInfo); OTHERWISE commandToPerform := HandleAlienEvent(theEventInfo); END; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.DoCommandKey(ch: CHAR; VAR info: EventInfo): TCommand; OVERRIDE; BEGIN DoCommandKey := NIL; IF (NOT info.theAutoKey) & (NOT InModalMenuState) THEN BEGIN SetupTheMenus; { If you want to have case sensitive command keys use the following line because KeyEventToComponents returns the correct character for shifted keys when the command key is down. That lets us test for things like command-period correctly. So… in order to be backward compatible (sigh) we now have to ignore the _correct_ char that is passed in (and is in info.theCharacter) and use the old ToolBox supplied unPasteurized character that is left in the actual EventRecord at info.thePEvent^ } { DoCommandKey := MenuEvent(MenuKey(ch)); } DoCommandKey := MenuEvent(MenuKey(chr(BAND(info.thePEvent^.message, charCodeMask)))); END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.DoKeyCommand(ch: CHAR; aKeyCode: integer; VAR info: EventInfo): TCommand; OVERRIDE; PROCEDURE HandleFunctionKey(cmd: CmdNumber); BEGIN SetupTheMenus; IF CmdEnabled(cmd) THEN DoKeyCommand := gTarget.DoMenuCommand(cmd); END; BEGIN DoKeyCommand := NIL; CASE aKeyCode OF kF1VirtualCode: HandleFunctionKey(cUndo); kF2VirtualCode: HandleFunctionKey(cCut); kF3VirtualCode: HandleFunctionKey(cCopy); kF4VirtualCode: HandleFunctionKey(cPaste); kClearVirtualCode: HandleFunctionKey(cClear); OTHERWISE DoKeyCommand := INHERITED DoKeyCommand(ch, aKeyCode, info); END; END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} FUNCTION TApplication.DoMakeDocument(itsCmdNumber: CmdNumber): TDocument; { E X A M P L E VAR aYOURDocument: TDocument; BEGIN New(aYOURDocument); aYOURDocument.IYOURDocument(itsDocKind, ...); DoMakeDocument := aYOURDocument; END; } VAR aDocument: TDocument; BEGIN { Allocate and initialize the document} aDocument := NIL; IF qTemplateViews THEN aDocument := TDocument(NewStdObject(kStdDocument)) ELSE New(aDocument); FailNil(aDocument); aDocument.IDocument(gMainFileType, '????', kUsesDataFork, NOT kUsesRsrcFork, NOT kDataOpen, NOT kRsrcOpen); DoMakeDocument := aDocument; END; {--------------------------------------------------------------------------------------------------} {$S MASelCommand} FUNCTION TApplication.DoMenuCommand(aCmdNumber: CmdNumber): TCommand; VAR succeeded: BOOLEAN; aDocument: TDocument; aWindow: TWindow; aNewDocCommand: TNewDocCommand; aOldDocCommand: TOldDocCommand; aAboutAppCommand: TAboutAppCommand; aQuitCommand: TQuitCommand; aUndoRedoCommand: TUndoRedoCommand; oldObjectPerm: BOOLEAN; just: INTEGER; {$IFC qDebug} aDebugCommand: TDebugCommand; oldState: BOOLEAN; {$ENDC} {$IFC qInspector} aInspectorCommand: TInspectorCommand; oldIState: BOOLEAN; {$ENDC} BEGIN { ================================================================================== Some commands will be returned to perform actions that must _ALWAYS_ be available. The allocation cannot be allowed to fail. So we do a temp allocation which by definition cannot be allowed to fail. This strategy is used wherever we want to use command objects but don't want to leave the user twisting in the breeze. NOTE: Don't forget to allow for this memory in your mem! resource if you copy this style in your own code. ================================================================================== } aWindow := GetActiveWindow; DoMenuCommand := NIL; CASE aCmdNumber OF cQuit: BEGIN oldObjectPerm := AllocateObjectsFromPerm(FALSE); New(aQuitCommand); IF AllocateObjectsFromPerm(oldObjectPerm) THEN; FailNil(aQuitCommand); { just in case } aQuitCommand.IQuitCommand(aCmdNumber); DoMenuCommand := aQuitCommand; END; cNew..cNewLast, cFinderNew: BEGIN New(aNewDocCommand); FailNil(aNewDocCommand); aNewDocCommand.INewDocCommand(aCmdNumber); DoMenuCommand := aNewDocCommand; END; cOpen..cOpenLast: BEGIN New(aOldDocCommand); FailNil(aOldDocCommand); aOldDocCommand.IOldDocCommand(aCmdNumber); DoMenuCommand := aOldDocCommand; END; cClose: BEGIN IF qDebug & (WMgrToWindow(FrontWindow) <> NIL) THEN ProgramBreak( 'The frontmost window is a window object but didn''t handle the cClose CmdNumber, your TWindow subclass probably forgot to call INHERITED DoMenuCommand!' ); CloseWMgrWindow(FrontWindow); { TWindow would have handled the command before we get here so the window is probably a DA or something } END; cShowClipboard: IF gClipWindow = aWindow THEN gClipWindow.Close { Hide the clipboard } ELSE BEGIN gClipWindow.Open; gClipWindow.Select; END; cAboutApp: BEGIN New(aAboutAppCommand); FailNil(aAboutAppCommand); aAboutAppCommand.IAboutAppCommand(aCmdNumber); DoMenuCommand := aAboutAppCommand; END; {$IFC qDebug} cDebugWind: DebugShowTranscriptWindow; cExperimenting: gExperimenting := NOT gExperimenting; cReportEvt: gReportEvt := NOT gReportEvt; cDebugPrinting: gDebugPrinting := NOT gDebugPrinting; cReportMenuChoices: gReportMenuChoices := NOT gReportMenuChoices; cIntenseDebugging: gIntenseDebugging := NOT gIntenseDebugging; cIdentifySoftware: BEGIN Writeln; Writeln('===== Software Version(s): ====='); Writeln(kCopyright); gTarget.IdentifySoftware; END; cRefreshFrontWindow: IF aWindow <> NIL THEN aWindow.ForceRedraw; cModalToggle: IF aWindow <> NIL THEN aWindow.fIsModal := NOT aWindow.fIsModal; cDoFirstClick: IF aWindow <> NIL THEN aWindow.fDoFirstClick := NOT aWindow.fDoFirstClick; cSetSysJust: BEGIN { swap the current setting } IF GetActualJustification(teJustSystem) = teJustLeft THEN just := teJustRight ELSE just := teJustLeft; { stuff the new setting } IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN SetSysJust(just) ELSE IF qNeedsROM128k | gConfiguration.hasROM128k THEN IntegerPtr(kLMTESysJust)^ := just; END; cEnterMacAppDebugger: BEGIN oldObjectPerm := AllocateObjectsFromPerm(FALSE); oldState := AddNewObjectsToInspector(FALSE); New(aDebugCommand); IF AddNewObjectsToInspector(oldState) THEN; IF AllocateObjectsFromPerm(oldObjectPerm) THEN; FailNil(aDebugCommand); { just in case } aDebugCommand.IDebugCommand(aCmdNumber); DoMenuCommand := aDebugCommand; END; {$ENDC} {$IFC qDebug} cTraceSetupMenus: gTraceSetupMenus := NOT gTraceSetupMenus; cTraceIdle: gTraceIdle := NOT gTraceIdle; {$ENDC} {$IFC qInspector} cNewInspectorWindow: BEGIN oldIState := AddNewObjectsToInspector(FALSE); New(aInspectorCommand); IF AddNewObjectsToInspector(oldIState) THEN; FailNil(aInspectorCommand); aInspectorCommand.IInspectorCommand(aCmdNumber); DoMenuCommand := aInspectorCommand; END; {$ENDC} cUndo { , cRedo } : BEGIN oldObjectPerm := AllocateObjectsFromPerm(FALSE); New(aUndoRedoCommand); IF AllocateObjectsFromPerm(oldObjectPerm) THEN; FailNil(aUndoRedoCommand); { just in case } aUndoRedoCommand.IUndoRedoCommand(aCmdNumber); DoMenuCommand := aUndoRedoCommand; END; OTHERWISE DoMenuCommand := INHERITED DoMenuCommand(aCmdNumber); END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.DoSetupMenus; VAR lowSpace: BOOLEAN; aWindowPtr: WindowPtr; BEGIN INHERITED DoSetupMenus; lowSpace := MemSpaceIsLow; Enable(cAboutApp, TRUE); Enable(cQuit, gEventLevel <= 1); { Can't enable Quit if in nested event handling } Enable(cShowClipboard, TRUE); SetMenuState(cShowClipboard, kIDBuzzString, bzShowClip, bzHideClip, gClipWindow = GetActiveWindow); Enable(cNew, NOT lowSpace); Enable(cOpen, NOT lowSpace); aWindowPtr := FrontWindow; IF (aWindowPtr <> NIL) & (WMgrToWindow(aWindowPtr) = NIL) THEN Enable(cClose, WindowPeek(aWindowPtr)^.goAwayFlag <> FALSE); { window objects will take care of themselves, but we take care of the indigent. } END; {--------------------------------------------------------------------------------------------------} {$S MAAboutApp} VAR hadCreditsStringList: BOOLEAN; { does the rsrc 'STR#' = kDefaultCredits exist ? } lastCreditsStringIndex: integer; { the last string in the STR# to be displayed } lastCreditsShownTicks: LONGINT; { the tickcount when the last Credit was Shown } originalText: StringHandle; { the about box's original text (prior to credits) } waitTicks: integer; { how long to wait between credits } FUNCTION DoShowAboutAppFilter(theDialog: DialogPtr; VAR theEvent: EventRecord; VAR itemHit: integer): BOOLEAN; VAR s: Str255; originalStr: Str255; item: Handle; FUNCTION GetFirstStaticText(theDialog: DialogPtr): Handle; VAR itemType: integer; item: Handle; itemNo: integer; box: Rect; BEGIN GetFirstStaticText := NIL; itemNo := 1; REPEAT item := NIL; GetDItem(theDialog, itemNo, itemType, item, box); IF BAND(itemType, $7F) = statText THEN { we don't care if its enabled or not } BEGIN GetFirstStaticText := item; LEAVE; END ELSE itemNo := succ(itemNo); UNTIL item = NIL; END; PROCEDURE DoKeyDown(itemNo: integer); { Handle a keypress that has been mapped to the OK button. } VAR itemType: integer; item: Handle; finalTicks: LONGINT; box: Rect; BEGIN DoShowAboutAppFilter := TRUE; itemHit := itemNo; GetDItem(theDialog, itemNo, itemType, item, box); IF itemType = (ctrlItem + btnCtrl) THEN BEGIN { this code gives visual feedback } HiliteControl(ControlHandle(item), inButton); { hilite the button } Delay(8, finalTicks); { delay for 8 ticks } HiliteControl(ControlHandle(item), 0); { stop hiliting the button } END; END; BEGIN DoShowAboutAppFilter := FALSE; CASE theEvent.what OF keyDown: CASE chr(BAND(theEvent.message, charCodeMask)) OF chEnter, chReturn: DoKeyDown(ok); END; nullEvent: IF (TickCount - lastCreditsShownTicks) > waitTicks THEN BEGIN item := GetFirstStaticText(theDialog); GetIndString(s, kDefaultCredits, lastCreditsStringIndex); IF s <> '' THEN BEGIN { save the original text } IF (lastCreditsStringIndex = 1) & (originalText^^ = '') & (item <> NIL) THEN BEGIN GetIText(item, originalStr); SetString(originalText, originalStr); END; lastCreditsStringIndex := succ(lastCreditsStringIndex); lastCreditsShownTicks := TickCount; IF item <> NIL THEN SetIText(item, s); waitTicks := Min((length(s) * 6), 60); END ELSE { no more items } BEGIN lastCreditsStringIndex := 1; lastCreditsShownTicks := TickCount; IF item <> NIL THEN BEGIN BlockMove(Ptr(originalText^), @originalStr, length(originalText^^) + 1); SetIText(item, originalStr); END; waitTicks := 6 * 60; END; END; END; { Forward on to the standard filter } IF gMacAppAlertFilter <> NIL THEN DoShowAboutAppFilter := CallAlertFilter(theDialog, theEvent, itemHit, gMacAppAlertFilter); END; PROCEDURE TApplication.DoShowAboutApp; { Method to display the "About" box for your application. Override to do interesting things. Since it is normally called from a command; the app usually has the maximum free space available. } VAR apName: Str255; apRefnum: integer; apParam: Handle; BEGIN FailSpaceIsLow; GetAppParms(apName, apRefnum, apParam); ParamText(apName, '', '', ''); { Put Application name in the about box } hadCreditsStringList := (GetResource('STR#', kDefaultCredits) <> NIL); IF hadCreditsStringList THEN BEGIN lastCreditsStringIndex := 1; lastCreditsShownTicks := TickCount; waitTicks := 5 * 60; originalText := NewString(''); IF MacAppAlert(phAboutApp, @DoShowAboutAppFilter) <> 0 THEN; Handle(originalText) := DisposeIfHandle(originalText); END ELSE StdAlert(phAboutApp); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.EachFreeWindow(PROCEDURE DoToWindow(aWindow: TWindow)); BEGIN gFreeWindowList.Each(DoToWindow); END; {--------------------------------------------------------------------------------------------------} {$S MAFields} PROCEDURE TApplication.Fields(PROCEDURE DoToField(fieldName: Str255; fieldAddr: Ptr; fieldType: integer)); OVERRIDE; BEGIN DoToField('TApplication', NIL, bClass); DoToField('fCommandQueue', @fCommandQueue, bObject); DoToField('fLastCommand', @fLastCommand, bObject); DoToField('fLaunchWithNewDocument', @fLaunchWithNewDocument, bBoolean); DoToField('fTicksOfLastIdle', @fTicksOfLastIdle, bLongint); DoToField('fTicksTilNextIdle', @fTicksTilNextIdle, bLongint); DoToField('gAppDone', @gAppDone, bBoolean); DoToField('gApplication', @gApplication, bObject); TextStyleFields('gApplicationStyle', gApplicationStyle, DoToField); {$IFC qDebug} DoToField('gBusyTempRgn', @gBusyTempRgn, bBoolean); {$EndC} DoToField('gChooserOK', @gChooserOK, bBoolean); DoToField('gClickCount', @gClickCount, bInteger); DoToField('gClipClaimed', @gClipClaimed, bBoolean); DoToField('gClipOrphanage', @gClipOrphanage, bObject); DoToField('gClipUndoView', @gClipUndoView, bObject); DoToField('gClipView', @gClipView, bObject); DoToField('gClipWindow', @gClipWindow, bObject); DoToField('gClipWrittenToDeskScrap', @gClipWrittenToDeskScrap, bBoolean); ConfigRecFields('gConfiguration', gConfiguration, DoToField); DoToField('gCouldPrint', @gCouldPrint, bBoolean); DoToField('gCurrPrintHandler', @gCurrPrintHandler, bObject); DoToField('gCursorRgn', @gCursorRgn, bRgnHandle); {$IFC qDebug} DoToField('gDebugPrinting', @gDebugPrinting, bBoolean); {$EndC} DoToField('gDocList', @gDocList, bObject); DoToField('gDrawingPictScrap', @gDrawingPictScrap, bBoolean); DoToField('gDrawingPictScrapView', @gDrawingPictScrapView, bObject); DoToField('gErrorParm3', @gErrorParm3, bString); DoToField('gEventLevel', @gEventLevel, bInteger); {$IFC qDebug} DoToField('gExperimenting', @gExperimenting, bBoolean); {$EndC} DoToField('gFileCount', @gFileCount, bInteger); DoToField('gFinderPrinting', @gFinderPrinting, bBoolean); DoToField('gFocusedView', @gFocusedView, bObject); DoToField('gFreeWindowList', @gFreeWindowList, bObject); DoToField('gGotClipType', @gGotClipType, bBoolean); DoToField('gHeadCohandler', @gHeadCoHandler, bObject); DoToField('gIdlePhase', @gIdlePhase, bByte); DoToField('gInBackground', @gInBackground, bBoolean); DoToField('gInitialized', @gInitialized, bBoolean); {$IFC qDebug} DoToField('gIntenseDebugging', @gIntenseDebugging, bBoolean); {$EndC} DoToField('gLastClickPart', @gLastClickPart, bInteger); DoToField('gLastDeskAcc', @gLastDeskAcc, bLongint); DoToField('gLastMsePt', @gLastMsePt, bPoint); DoToField('gLastUpTime', @gLastUpTime, bLongint); DoToField('gLongOffset', @gLongOffset, bVPoint); DoToField('gLowSpaceInterval', @gLowSpaceInterval, bLongint); DoToField('gMainEventMask', @gMainEventMask, bHexInteger); DoToField('gMainFileType', @gMainFileType, bOSType); DoToField('gMBarDisplayed', @gMBarDisplayed, bInteger); DoToField('gMBarHeight', @gMBarHeight, bInteger); DoToField('gMBarHierarchical', @gMBarHierarchical, bInteger); DoToField('gMBarNotDisplayed', @gMBarNotDisplayed, bInteger); DoToField('gMenusAreSetup', @gMenusAreSetup, bBoolean); ScrapStuffFields('gNewScrapStuff', gNewScrapStuff, DoToField); DoToField('gNextSpaceMsg', @gNextSpaceMsg, bLongint); DoToField('gNoChanges', @gNoChanges, bObject); DoToField('gNullPrintHandler', @gNullPrintHandler, bObject); DoToField('gNumUntitled', @gNumUntitled, bInteger); DoToField('gOldChooserFlag', @gOldChooserFlag, bBoolean); ScrapStuffFields('gOldScrapStuff', gOldScrapStuff, DoToField); DoToField('gOrthogonal[h]', @gOrthogonal[h], bByte); DoToField('gOrthogonal[v]', @gOrthogonal[v], bByte); DoToField('gPageOffset', @gPageOffset, bVPoint); DoToField('gPrefClipType', @gPrefClipType, bOSType); DoToField('gPrintHandler', @gPrintHandler, bObject); DoToField('gPrinting', @gPrinting, bBoolean); DoToField('gRedrawMenuBar', @gRedrawMenuBar, bBoolean); {$IFC qDebug} DoToField('gReportEvt', @gReportEvt, bBoolean); {$EndC} {$IFC qDebug} DoToField('gReportMenuChoices', @gReportMenuChoices, bBoolean); {$EndC} {$IFC qDebug} DoToField('gRsrcCheck', @gRsrcCheck, bBoolean); {$EndC} DoToField('gSaveFocusRec', NIL, bTitle); DoToField(' isValid', @gSaveFocusRec.isValid, bBoolean); DoToField(' clip', @gSaveFocusRec.clip, bRgnHandle); DoToField(' drawingPictScrap', @gSaveFocusRec.drawingPictScrap, bBoolean); DoToField(' drawingPictScrapView', @gSaveFocusRec.drawingPictScrapView, bObject); DoToField(' focusedView', @gSaveFocusRec.focusedView, bObject); DoToField(' longOffset', @gSaveFocusRec.longOffset, bVPoint); DoToField(' org', @gSaveFocusRec.org, bPoint); DoToField(' port', @gSaveFocusRec.port, bWindowPtr); DoToField(' printing', @gSaveFocusRec.printing, bBoolean); DoToField('gSignatureCount', @gSignatureCount, bInteger); DoToField('gStdHysteresis', @gStdHysteresis, bPoint); DoToField('gStdStaggerCount', @gStdStaggerCount, bInteger); DoToField('gStdWMoveBounds', @gStdWMoveBounds, bRect); DoToField('gStdWSizeRect', @gStdWSizeRect, bRect); DoToField('gStdWScreenRect', @gStdWScreenRect, bRect); DoToField('gSysWindowActive', @gSysWindowActive, bBoolean); TextStyleFields('gSystemStyle', gSystemStyle, DoToField); DoToField('gTarget', @gTarget, bObject); DoToField('gTempRgn', @gTempRgn, bRgnHandle); {$IFC qDebug} DoToField('gTraceIdle', @gTraceIdle, bBoolean); {$EndC} DoToField('gUndoState', @gUndoState, bBoolean); DoToField('gUndoCmd', @gUndoCmd, bInteger); {$IFC qDebug} DoToField('gUsedBy', @gUsedBy, bString); {$EndC} DoToField('gVarClipPicSize', @gVarClipPicSize, bBoolean); DoToField('gWorkPort', @gWorkPort, bGrafPtr); DoToField('gWResSignature', @gWResSignature, bIDType); DoToField('gWResType', @gWResType, bString); DoToField('gZeroPt', @gZeroPt, bPoint); DoToField('gZeroRect', @gZeroRect, bRect); DoToField('gZeroVPt', @gZeroVPt, bVPoint); DoToField('gZeroVRect', @gZeroVRect, bVRect); INHERITED Fields(DoToField); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.ForAllDocumentsDo(PROCEDURE DoToDoc(aDocument: TDocument)); BEGIN gDocList.Each(DoToDoc); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.ForAllWindowsDo(PROCEDURE DoToWind(aWindow: TWindow)); PROCEDURE DoToYourWindows(aDocument: TDocument); BEGIN aDocument.ForAllWindowsDo(DoToWind); END; BEGIN ForAllDocumentsDo(DoToYourWindows); EachFreeWindow(DoToWind); END; {--------------------------------------------------------------------------------------------------} {$S MAInspector} PROCEDURE TApplication.GetInspectorName(VAR inspectorName: Str255); BEGIN IF SELF = gApplication THEN inspectorName := 'gApplication'; END; {--------------------------------------------------------------------------------------------------} {$S MAClipboard} FUNCTION TApplication.GetDataToPaste(aDataHandle: Handle; VAR dataType: ResType): LONGINT; VAR err: LONGINT; myType: ResType; BEGIN IF gGotClipType THEN BEGIN dataType := gPrefClipType; err := gClipView.GivePasteData(aDataHandle, dataType); IF err < 0 THEN Failure(err, 0); END ELSE BEGIN {$IFC qDebug} ProgramBreak('GetDataToPaste called when gGotClipType was FALSE'); {$ENDC} END; GetDataToPaste := err; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.GetEvent(eventMask: integer; sleep: LONGINT; cursorRgn: RgnHandle; VAR anEvent: EventRecord): BOOLEAN; CONST kMaxSleep = 60; { max sleep in foreground so MultiFinder gives time to non-desk accessory drivers } VAR haveEvent: BOOLEAN; {$IFC qPerform} oldSetting: BOOLEAN; {$ENDC} BEGIN {$IFC qDebug} gRsrcCheck := gRsrcCheck - 1; IF gRsrcCheck <= 0 THEN BEGIN CheckRsrcUsage; gRsrcCheck := kRsrcCheckInterval; END; {$ENDC qDebug} IF qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent THEN BEGIN {$IFC qDebug} IF gIntenseDebugging & gReportEvt THEN BEGIN WRITE('WaitNextEvent: sleep=', sleep: 0); { faceless driver bug fixed in MF 7.0 } IF (gConfiguration.systemVersion < $700) & NOT gInBackground THEN WRITE(', MaxSleep=', kMaxSleep: 0); IF cursorRgn = NIL THEN WRITE(', cursor region=NIL') ELSE WrLblRect(', cursor', cursorRgn^^.rgnBBox); Writeln; END; {$ENDC} ActivateBusyCursor(FALSE); { Turn off busy cursor while we're away.} {$IFC qPerform} oldSetting := DebugPerfMonitor(FALSE); {$ENDC} { faceless driver bug fixed in MF 7.0 } IF (gConfiguration.systemVersion < $700) & NOT gInBackground THEN sleep := Min(sleep, kMaxSleep); haveEvent := WaitNextEvent(eventMask, anEvent, sleep, cursorRgn); {$IFC qPerform} IF DebugPerfMonitor(oldSetting) THEN; {$ENDC} IF NOT gInBackground THEN { If we're not in the background, then } ActivateBusyCursor(TRUE); { …enable the busy cursor mechanism. } END ELSE BEGIN {$IFC qPerform} oldSetting := DebugPerfMonitor(FALSE); {$ENDC} SystemTask; haveEvent := GetNextEvent(eventMask, anEvent); {$IFC qPerform} IF DebugPerfMonitor(oldSetting) THEN; {$ENDC} END; GetEvent := haveEvent; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.GetFrontWindow: TWindow; PROCEDURE DoToWMgrWindow(theWMgrWindow: WindowPtr); VAR aWindow: TWindow; BEGIN aWindow := WMgrToWindow(theWMgrWindow); IF (aWindow <> NIL) & aWindow.IsShown & (NOT aWindow.fFloats) THEN BEGIN GetFrontWindow := aWindow; EXIT(GetFrontWindow) END; END; BEGIN GetFrontWindow := NIL; IF NOT IsDeskAccessory(FrontWindow) THEN EachWMgrWindowDo(DoToWMgrWindow); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.GetActiveWindow: TWindow; PROCEDURE DoToWMgrWindow(theWMgrWindow: WindowPtr); VAR aWindow: TWindow; BEGIN aWindow := WMgrToWindow(theWMgrWindow); IF (aWindow <> NIL) & aWindow.IsShown & aWindow.fIsActive & (NOT aWindow.fFloats) THEN BEGIN GetActiveWindow := aWindow; EXIT(GetActiveWindow) END; END; BEGIN GetActiveWindow := NIL; IF NOT IsDeskAccessory(FrontWindow) THEN EachWMgrWindowDo(DoToWMgrWindow); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.GetLastCommand: TCommand; BEGIN GetLastCommand := fLastCommand; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.GetNextCommand: TCommand; VAR aCommand: TCommand; FUNCTION IsReadyToGo(command: TCommand): BOOLEAN; BEGIN IsReadyToGo := command.IsReadyToExecute; END; BEGIN IF NOT fCommandQueue.IsEmpty THEN BEGIN aCommand := TCommand(fCommandQueue.FirstThat(IsReadyToGo)); IF (aCommand <> NIL) & NOT aCommand.fRecurring THEN fCommandQueue.Delete(aCommand); GetNextCommand := aCommand; END ELSE GetNextCommand := NIL; END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} { ??? We should not muck with the window template; the extra code isn't worth it since programmer can easily change the resource file ??? } FUNCTION TApplication.GetRsrcWindow(storage: Ptr; rsrcId: integer; VAR isResizable, isClosable: BOOLEAN): WindowPtr; { We force INVISIBLE in the WIND definition so the screen won't flash. } TYPE WINDTemplate = RECORD bounds: Rect; procID: integer; visible, filler1: BOOLEAN; goAway, filler2: BOOLEAN; refcon: LONGINT; itemsID: integer; { only for DLOG resource } END; WINDTemplatePtr = ^WINDTemplate; WINDTemplateHandle = ^WINDTemplatePtr; VAR aWMgrWindow: WindowPtr; templateHandle: WINDTemplateHandle; rsrcType: ResType; ditl: Handle; oldPerm: BOOLEAN; fi: FailInfo; PROCEDURE HdlFailure(error: integer; message: LONGINT); { ??? ERROR ??? } BEGIN { Make sure the perm allocation flag is set back to what it was when we entered GetRsrcWindow. } oldPerm := PermAllocation(oldPerm); END; BEGIN oldPerm := PermAllocation(FALSE); { Even though the window is permanent, we allocate it under a temporary flag so that the maximum memory is available. Quickdraw can blow up if it can't allocate a grafPort. } CatchFailures(fi, HdlFailure); templateHandle := WINDTemplateHandle(GetResource('WIND', rsrcId)); FailNILResource(templateHandle); MoveHHi(Handle(templateHandle)); { in case it is locked by the ROM } WITH templateHandle^^ DO BEGIN { ignore request for zoomDocProc if not 128K ROM, because the user might be running pre-3.0 System, which can't handle zoomDocProc } IF NOT qNeedsROM128K & NOT gConfiguration.hasROM128K THEN procID := BAND(procID, $FFF7); visible := FALSE; isClosable := goAway; isResizable := (procID = documentProc) | (procID = zoomDocProc); { If your own defProc is resizable, too, then after the call on GetRsrcWindow, set isResizable TRUE } END; IF qNeedsColorQD | gConfiguration.hasColorQD THEN aWMgrWindow := WindowPtr(GetNewCWindow(rsrcId, Pointer(storage), Pointer( - 1))) ELSE aWMgrWindow := GetNewWindow(rsrcId, Pointer(storage), Pointer( - 1)); FailNil(aWMgrWindow); oldPerm := PermAllocation(oldPerm); Success(fi); { Don't need the failure handler since we've set the perm allocation flag back. } { Now we must make sure that the code reserve is still intact.} IF NOT CheckReserve THEN BEGIN aWMgrWindow := FreeIfWMgrWindow(aWMgrWindow, storage = NIL); Failure(memFullErr, 0); END; GetRsrcWindow := aWMgrWindow; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.HandleActivateEvent(VAR theEventInfo: EventInfo): TCommand; VAR aWindow: TWindow; BEGIN WITH theEventInfo, thePEvent^ DO BEGIN aWindow := WMgrToWindow(WindowPtr(message)); IF aWindow <> NIL THEN aWindow.Activate(Odd(modifiers)); END; HandleActivateEvent := NIL; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.HandleAlienEvent(VAR theEventInfo: EventInfo): TCommand; VAR aCommand: TCommand; anEvtHandler: TEvtHandler; FUNCTION TakeEvent(anEvtHandler: TEvtHandler): BOOLEAN; BEGIN TakeEvent := anEvtHandler.DoHandleEvent(theEventInfo.thePEvent, aCommand); END; BEGIN aCommand := NIL; IF gHeadCoHandler <> NIL THEN anEvtHandler := gHeadCoHandler.FirstHandlerThat(TakeEvent); HandleAlienEvent := aCommand; END; {--------------------------------------------------------------------------------------------------} {$S MADoCommand} FUNCTION TApplication.HandleDiskEvent(VAR theEventInfo: EventInfo): TCommand; CONST topLeft = $00500070; VAR err: integer; BEGIN WITH theEventInfo.thePEvent^ DO IF HiWrd(message) <> noErr THEN BEGIN err := DIBadMount(Point(topLeft), message); { ??? do something with the error ??? } {$IFC qDebug} IF err <> noErr THEN Writeln('error from DIBadMount is ', err: 1); {$ENDC} END; HandleDiskEvent := NIL; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.HandleEvent(VAR theEvent: EventRecord); VAR fi: FailInfo; commandToPerform: TCommand; theEventInfo: EventInfo; {$IFC qDebug} aMAName: MAName; {$ENDC} PROCEDURE HandleFailure(error: OSErr; message: LONGINT); BEGIN PostHandleEvent(theEventInfo); END; BEGIN {$IFC qDebug} IF gReportEvt THEN ReportEvent(theEvent); {$ENDC} WITH theEventInfo, theEvent DO BEGIN thePEvent := @theEvent; theBtnState := BAND(modifiers, btnState) <> 0; theCmdKey := BAND(modifiers, cmdKey) <> 0; theShiftKey := BAND(modifiers, shiftKey) <> 0; theAlphaLock := BAND(modifiers, alphaLock) <> 0; theOptionKey := BAND(modifiers, optionKey) <> 0; theControlKey := BAND(modifiers, controlKey) <> 0; theAutoKey := what = autoKey; theClickCount := gClickCount; theCharacter := chr(0); { Default, we don't know if this is a keystroke yet } theKeyCode := 0; { Default, we don't know if this is a keystroke yet } affectsMenus := TRUE; { assume going in that this event affects the menus } END; CatchFailures(fi, HandleFailure); DispatchEvent(theEventInfo, commandToPerform); IF (commandToPerform <> NIL) THEN { Send the command out to be executed } PostCommand(commandToPerform); Success(fi); PostHandleEvent(theEventInfo); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION OptionKeyIsDown: BOOLEAN; CONST kOptionKey = 58; VAR theKeys: KeyMap; BEGIN GetKeys(theKeys); OptionKeyIsDown := theKeys[kOptionKey]; END; {--------------------------------------------------------------------------------------------------} {$S MAFinder} PROCEDURE TApplication.HandleFinderRequest; LABEL 1, 2; VAR i: integer; anAppFile: AppFile; continuePrinting: BOOLEAN; cmd: CmdNumber; fi: FailInfo; aCommand: TCommand; { ??? need better error messages here ??? } PROCEDURE HdlORequest(error: OSErr; message: LONGINT); BEGIN IF error <> noErr THEN BEGIN IF message = 0 THEN BEGIN gErrorParm3 := anAppFile.fName; IF cmd = cFinderPrint THEN message := msgPrintFailed ELSE message := msgOpenFailed; END; ShowError(error, message); END; GOTO 1; { continue the loop } END; PROCEDURE HdlNRequest(error: OSErr; message: LONGINT); BEGIN IF error <> noErr THEN ShowError(error, message); { PollEvent's error handler not in place yet } GOTO 2; { exit the method } END; BEGIN {$IFC qDebug} IF gExperimenting THEN Writeln('File count: ', gFileCount: 1); {$ENDC} IF gFileCount = 0 THEN BEGIN aCommand := NIL; CatchFailures(fi, HdlNRequest); IF OptionKeyIsDown THEN aCommand := DoMenuCommand(cOpen) ELSE IF fLaunchWithNewDocument THEN aCommand := DoMenuCommand(cFinderNew); IF aCommand <> NIL THEN PostCommand(aCommand); Success(fi); END ELSE { it's an OPEN or PRINT of 1 or more existing files } BEGIN continuePrinting := TRUE; IF gFinderPrinting THEN cmd := cFinderPrint ELSE cmd := cFinderOpen; FOR i := 1 TO gFileCount DO BEGIN CatchFailures(fi, HdlORequest); GetAppFiles(i, anAppFile); IF CanOpenDocument(cmd, anAppFile) THEN BEGIN ClrAppFiles(i); IF gFinderPrinting THEN BEGIN IF continuePrinting THEN continuePrinting := PrintDocument(anAppFile); END ELSE OpenOld(cFinderOpen, anAppFile); END ELSE Failure(errNotMyType, 0); Success(fi); 1: { continue the loop } END; END; 2: { exit the method } END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.HandleKeyDownEvent(VAR theEventInfo: EventInfo): TCommand; BEGIN WITH theEventInfo, thePEvent^ DO BEGIN gTarget.KeyEventToComponents(theEventInfo); { Find out what keys were _REALLY_ pressed } IF theCmdKey THEN HandleKeyDownEvent := gTarget.DoCommandKey(theCharacter, theEventInfo) ELSE HandleKeyDownEvent := gTarget.DoKeyCommand(theCharacter, theKeyCode, theEventInfo); END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.HandleMouseDown(VAR theEventInfo: EventInfo): TCommand; VAR doClick: BOOLEAN; aWindow: TWindow; aWMgrWindow: WindowPtr; whereMouseDown: integer; sysWindowAct: BOOLEAN; aCommand: TCommand; theMouse: Point; theVMouse: VPoint; hysteresis: Point; BEGIN HandleMouseDown := NIL; WITH theEventInfo, thePEvent^ DO BEGIN whereMouseDown := FindWindow(where, aWMgrWindow); theClickCount := CountClicks(thePEvent, whereMouseDown); aWindow := WMgrToWindow(aWMgrWindow); IF ((whereMouseDown = inMenuBar) & InModalMenuState) | ((whereMouseDown <> inMenuBar) & InModalState & (aWindow <> GetActiveWindow)) THEN BEGIN Beep(2); EXIT(HandleMouseDown); END; END; IF whereMouseDown <> inContent THEN SetCursor(arrow); WITH theEventInfo, thePEvent^ DO CASE whereMouseDown OF inMenuBar: BEGIN SetupTheMenus; { gives application a chance to setup individual menu items } HandleMouseDown := MenuEvent(MenuSelect(where)); END; inSysWindow: SystemClick(thePEvent^, aWMgrWindow); OTHERWISE { if a MacApp window was associated with the WindowPtr then let the window object decide what to do with the mouse click } IF (aWindow <> NIL) & aWindow.Focus THEN { if we can't focus, we're in trouble } BEGIN theMouse := where; GlobalToLocal(theMouse); aWindow.QDToViewPt(theMouse, theVMouse); hysteresis := gStdHysteresis; { don't want std changed by var } IF aWindow.HandleMouseDown(theVMouse, theEventInfo, hysteresis, aCommand) & (aCommand <> NIL) THEN BEGIN aCommand.fTracksMouse := TRUE; {??? someday this won't be forced } aCommand.fInitialPt := where; {??? someday this won't be forced } HandleMouseDown := aCommand; END; END ELSE IF qDebug THEN BEGIN IF aWindow <> NIL THEN ProgramBreak( 'In TApplication.HandleMouseDown: couldn''t focus on a window object!' ) ELSE IF gIntenseDebugging THEN Writeln('Got a mouse event for a non-MacApp, non-system window'); END; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.HandleMouseUp(VAR theEventInfo: EventInfo): TCommand; BEGIN { Remember time of last mouse up, in order to detect double clicks } gLastUpTime := theEventInfo.thePEvent^.when; HandleMouseUp := NIL; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.HandleSystemEvent(VAR theEventInfo: EventInfo): TCommand; CONST kOsEvtMessageMask = $FF000000; VAR switchingIn: BOOLEAN; convertClipboard: BOOLEAN; aWindow: TWindow; BEGIN WITH theEventInfo.thePEvent^ DO CASE BSR(BAND(message, kOsEvtMessageMask), 24) OF kSuspendOrResume: BEGIN switchingIn := Odd(message); convertClipboard := BAND(message, $00000002) <> 0; IF switchingIn THEN RegainControl(convertClipboard) ELSE AboutToLoseControl(convertClipboard); IF switchingIn THEN aWindow := GetFrontWindow ELSE aWindow := GetActiveWindow; IF aWindow <> NIL THEN aWindow.Activate(switchingIn); gInBackground := NOT switchingIn; InvalidateCursorRgn; END; kMouseMovedMessage: BEGIN theEventInfo.affectsMenus := FALSE; { We don't think mouse tracking usually bothers the menus. } IF TrackCursor THEN; { Recalculate the cursor region. After all that's why we got a mouse moved event } END; OTHERWISE IF gIntenseDebugging THEN Writeln('in TApplication.HandleSystemEvent: got unrecognized event'); END; HandleSystemEvent := NIL; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.HandleUpdateEvent(VAR theEventInfo: EventInfo): TCommand; VAR aWindow: TWindow; BEGIN WITH theEventInfo.thePEvent^ DO BEGIN aWindow := WMgrToWindow(WindowPtr(message)); IF aWindow <> NIL THEN aWindow.Update; END; HandleUpdateEvent := NIL; END; {--------------------------------------------------------------------------------------------------} {$S MADebug} PROCEDURE TApplication.IdentifySoftware; BEGIN WRITELN('UMacApp of 14 Feb 90 (Valentine''s Day), Compiled on ', COMPDATE, ' @ ', COMPTIME); IDUObject; {$IFC qDebug} IDUDebug; {$EndC} END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.Idle(phase: IdlePhase); VAR currTick: LONGINT; fi: FailInfo; PROCEDURE HdlIdle(error: OSErr; message: LONGINT); BEGIN gInhibitNestedHandling := TRUE; { Don't want to come back into Idle From alert filters or other strange places } END; PROCEDURE DoIdleAction(anEvtHandler: TEvtHandler); VAR didFree: BOOLEAN; ticksTilNextIdle: LONGINT; BEGIN { If this handler needs idling, and enough ticks have elapsed since the last time it was idled, call its DoIdle. (This was not made a TEvtHandler method in order to optimize idling speed.) } WITH anEvtHandler DO BEGIN didFree := FALSE; IF fIdleFreq <> kMaxIdleTime THEN { Does it idle at all? } BEGIN IF (phase <> idleContinue) | (currTick - fLastIdle >= fIdleFreq) THEN BEGIN didFree := anEvtHandler.DoIdle(phase); IF NOT didFree THEN fLastIdle := currTick; END; IF NOT didFree & (fIdleFreq <> kMaxIdleTime) THEN BEGIN IF fLastIdle = 0 THEN ticksTilNextIdle := fIdleFreq ELSE ticksTilNextIdle := Max(fLastIdle + fIdleFreq - currTick, 0); { accounts for overdue } fTicksTilNextIdle := Min(ticksTilNextIdle, fTicksTilNextIdle); { update the composite } END; END; END; END; BEGIN CatchFailures(fi, HdlIdle); currTick := TickCount; IF phase = idleBegin THEN BEGIN {$IFC qDebug} gWasTrcEnable := TRCEnable(gTraceIdle); { Trace during idle only if user wants to. } {$ENDC} IF NOT gInFilter & MemSpaceIsLow THEN SpaceIsLow ELSE gNextSpaceMsg := currTick; SetupTheMenus; { To get the menu bar redrawn if necessary.} fTicksTilNextIdle := 0; { Force idling event handlers & co-handlers.} END; IF (phase <> idleContinue) | (currTick - fTicksOfLastIdle >= fTicksTilNextIdle) THEN BEGIN fTicksTilNextIdle := kMaxIdleTime; IF gHeadCoHandler <> NIL THEN gHeadCoHandler.EachHandler(DoIdleAction); IF qDebug THEN Assertion(gTarget <> NIL, AtStr('gTarget <> nil')); gTarget.EachHandler(DoIdleAction); fTicksOfLastIdle := currTick; END; { If we have WaitNextEvent then the cursor will be tracked via MouseMoved events. } IF (NOT (qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent) | gAlwaysTrackCursor) & (phase <> idleEnd) THEN BEGIN IF TrackCursor THEN; { Recompute the cursor region if necessary. } END {$IFC qDebug} ELSE IF TRCEnable(gWasTrcEnable) THEN { restore tracing state at end of idle.} {$ENDC} ; Success(fi); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.InModalState: BOOLEAN; VAR aWindow: TWindow; aWindowPtr: WindowPtr; BEGIN InModalState := FALSE; { Initialize the function result } aWindowPtr := FrontWindow; { in case the front window is an alert or something } IF (WMgrToWindow(aWindowPtr) = NIL) & (aWindowPtr <> NIL) THEN CASE GetWindowVariant(aWindowPtr) OF dBoxProc, plainDBox, altDBoxProc: InModalState := TRUE; END ELSE BEGIN aWindow := GetActiveWindow; InModalState := (aWindow <> NIL) & (aWindow.fIsModal); END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.InModalMenuState: BOOLEAN; VAR aWindow: TWindow; aWindowPtr: WindowPtr; BEGIN InModalMenuState := FALSE; { Initialize the function result } aWindowPtr := FrontWindow; { in case the front window is an alert or something } IF (WMgrToWindow(aWindowPtr) = NIL) & (aWindowPtr <> NIL) THEN CASE GetWindowVariant(aWindowPtr) OF dBoxProc, plainDBox, altDBoxProc: InModalMenuState := TRUE; END ELSE BEGIN aWindow := GetActiveWindow; InModalMenuState := (aWindow <> NIL) & NOT aWindow.AllowsMenuAccess; END; END; {--------------------------------------------------------------------------------------------------} {$S MANonRes} PROCEDURE TApplication.InstallCohandler(aCohandler: TEvtHandler; addIt: BOOLEAN); BEGIN fTicksTilNextIdle := 0; { Force idling event handlers & co-handlers.} IF addIt THEN gHeadCoHandler := aCohandler.AddHandler(gHeadCoHandler) ELSE gHeadCoHandler := aCohandler.RemoveHandler(gHeadCoHandler); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.IsDeskAccessory(aWMgrWindow: WindowPtr): BOOLEAN; BEGIN IsDeskAccessory := (aWMgrWindow <> NIL) & (WindowPeek(aWMgrWindow)^.windowKind < 0); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.InvalidateCursorRgn; BEGIN IF gCursorRgn <> NIL THEN SetEmptyRgn(gCursorRgn); { Make sure it gets changed back } END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.InvalidateFocus; BEGIN IF gFocusedView <> NIL THEN gFocusedView.InvalidateFocus; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.KeyEventToComponents(VAR info: EventInfo); { See Tech Note #263 for the reason for this abomination } CONST kMaskModifier = $FE00; { need to strip command key from Modifiers } kMaskASCII1 = $000000FF; { get key from KeyTrans return } kMaskASCII2 = $00FF0000; { get key from KeyTrans return } kPeriod = ord('.'); kUpKeyMask = $0080; kMAsmKeyCache = 38; {!!! Replace with system supplied constant when sys 7.0 headers ship } TYPE { !!! Delete this record for 7.0 only operation. This is really a private record so _DON'T_ use any other fields! } MAExpandMemRec = RECORD emVersion: integer; { version of expanded memory } emSize: LONGINT; { length of em } emIntlGlobals: LONGINT; { international globals pointer } emKeyDeadState: LONGINT; { Key1Trans, Key2Trans dead state } emKeyCache: Ptr; { KCHR keyboard cache } emIntlDef: LONGINT; { Reserved for Intl } emFirstKeyboard: BOOLEAN; { flag byte } emAlign: BOOLEAN; { long-align until we need this storage } emItlCache: ARRAY [0..3] OF LONGINT; { bytes in cache } emItlNeedUnlock: BOOLEAN; { for pack6 } emItlDirectGetIntl: BOOLEAN; { for pack6 } emFiller: ARRAY [1..22] OF CHAR; { Reserved room } END; MAExpandMemRecPtr = ^MAExpandMemRec; MAExpandMemRecHandle = ^MAExpandMemRecPtr; VAR keyCodeParameter: integer; { See IM-V pp. 195 } virtualKey: LONGINT; keyInfo: LONGINT; theChar: LONGINT; state: LONGINT; keyTransTable: Ptr; BEGIN INHERITED KeyEventToComponents(info); { Get default translation, if any } IF qNeedsScriptManager | gConfiguration.hasScriptManager THEN BEGIN WITH info, thePEvent^ DO IF (what = keyDown) | (what = autoKey) THEN BEGIN { Now see if the command key is down. If it is, get the correct ASCII translation by masking the command key out and re-translating because the command key will mask the shift modifier. } IF theCmdKey THEN BEGIN { set the upkey bit so KeyTrans doesn't do special deadkey processing } keyCodeParameter := BOR(BOR(BAND(modifiers, kMaskModifier), theKeyCode), kUpKeyMask); state := 0; { Get the correct keytable pointer. We don't want to grope the system unnecessarily so use the script managers improvements if they're there. } IF gConfiguration.systemVersion >= $700 THEN keyTransTable := Ptr(GetEnvirons(kMAsmKeyCache)) ELSE { Fake handle. the lomem address is a pointer to the table } keyTransTable := Ptr(MAExpandMemRecHandle(ExpandMem)^^.emKeyCache); keyInfo := KeyTrans(keyTransTable, keyCodeParameter, state); theCharacter := chr(BAND(keyInfo, kMaskASCII1)); IF theCharacter = chr(0) THEN theCharacter := chr(BSR(BAND(keyInfo, kMaskASCII2), 16)); END; END; END; END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} FUNCTION TApplication.KindOfDocument(itsCmdNumber: CmdNumber; itsAppFilePtr: AppFilePtr): CmdNumber; BEGIN KindOfDocument := itsCmdNumber; END; {--------------------------------------------------------------------------------------------------} {$S MAInit} PROCEDURE TApplication.LaunchClipboard; BEGIN AbsorbScrapStuff; { Get current scrapCount as a baseline } ReadFromDeskScrap; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} { must be in the main segment } PROCEDURE TApplication.MainEventLoop; BEGIN gIdlePhase := idleBegin; REPEAT IF gIdlePhase = idleBegin THEN UnloadAllSegments; { don't unload segs after idle has begun } { ??? should we (1) unload segs after completing idle but before doing the event? (2) unload segs while processing event during background printing? } PollEvent(kAllowApplicationToSleep); UNTIL gAppDone; { gAppDone is a global BOOLEAN; that we set TRUE when the user chooses 'Quit' } END; {--------------------------------------------------------------------------------------------------} {$S MAInit} FUNCTION TApplication.MakeClipboardWindow: TWindow; VAR aDeskScrapView: TDeskScrapView; BEGIN IF qTemplateViews THEN MakeClipboardWindow := NewTemplateWindow(kIDClipWindow, NIL) ELSE BEGIN New(aDeskScrapView); FailNil(aDeskScrapView); aDeskScrapView.IDeskScrapView; aDeskScrapView.fIdentifier := KIDClipView; MakeClipboardWindow := NewSimpleWindow(kIDClipWindow, TRUE, TRUE, NIL, aDeskScrapView); END; END; {--------------------------------------------------------------------------------------------------} {$S MAClipboard} FUNCTION TApplication.MakeViewForAlienClipboard: TView; BEGIN { If the application doesn't override this then we just set the clipboard view to the orphanage, which handles TEXT and PICT scraps in a standard way. } MakeViewForAlienClipboard := gClipOrphanage; END; {--------------------------------------------------------------------------------------------------} {$S MASelCommand} FUNCTION TApplication.MenuEvent(menuItem: LONGINT): TCommand; VAR fi: FailInfo; cmd: CmdNumber; deskAccName: Str255; theMenuNumber: integer; theItemNumber: integer; PROCEDURE HdlMenuEvt(error: OSErr; message: LONGINT); BEGIN IF gSysWindowActive THEN ActivateBusyCursor(FALSE); FailNewMessage(error, message, BuildMessage(cmd, msgCmdErr)); END; BEGIN MenuEvent := NIL; theMenuNumber := HiWrd(menuItem); theItemNumber := LoWrd(menuItem); IF theMenuNumber <> 0 THEN BEGIN cmd := CmdFromMenuItem(theMenuNumber, theItemNumber); {$IFC qDebug} IF cmd = cCantUndo THEN BEGIN Writeln('Command number ', cCantUndo: 1, ' is reserved for MacApp.'); ProgramBreak('Use of reserved command number.'); END; IF gReportMenuChoices & (cmd > 0) THEN Writeln('Menu Choice Command Number = ', cmd: 1); {$ENDC qDebug} IF (cmd < 0) & (theMenuNumber = mApple) THEN BEGIN GetItem(MAGetMenu(mApple), theItemNumber, deskAccName); OpenDeskAccessory(deskAccName); END ELSE IF (cmd < cEditBase) | (cmd > cEditLast) | (NOT SystemEdit(cmd - cEditBase)) THEN BEGIN CatchFailures(fi, HdlMenuEvt); IF gSysWindowActive THEN ActivateBusyCursor(TRUE); MenuEvent := gTarget.DoMenuCommand(cmd); IF gSysWindowActive THEN ActivateBusyCursor(FALSE); Success(fi); END; END; END; {--------------------------------------------------------------------------------------------------} {$S MASelCommand} PROCEDURE TApplication.OpenDeskAccessory(deskAccName: Str255); VAR aRefNum: integer; drvrH: Handle; theID: integer; theType: ResType; theName: Str255; oldPerm: BOOLEAN; ourHeap: BOOLEAN; fi: FailInfo; err: OSErr; savedPort: GrafPtr; PROCEDURE HdlOpenDeskAcc(error: OSErr; message: LONGINT); BEGIN IF aRefNum <> 0 THEN CloseDeskAcc(aRefNum); IF message = 0 THEN BEGIN gErrorParm3 := deskAccName; { Get rid of leading null character } IF ord(gErrorParm3[1]) = 0 THEN Delete(gErrorParm3, 1, 1); END; FailNewMessage(error, message, msgOpenFailed); END; FUNCTION IsOpen(itsID: integer): BOOLEAN; VAR dceHnd: DCtlhandle; BEGIN IsOpen := FALSE; IF (itsID >= 0) & (itsID < GetUnitNtryCnt) THEN BEGIN dceHnd := GetUTableBase^[itsID]; IF (dceHnd <> NIL) & BTst(dceHnd^^.dCtlFlags, 5) THEN IsOpen := TRUE; END; END; BEGIN CatchFailures(fi, HdlOpenDeskAcc); aRefNum := 0; { Make sure failure handler works. } { Attempt to load the DA into memory. If 'deskAccName' refers to another app } { rather than a real desk acc, then GetNamedResource returns a faked up handle } { courtesy of MultiFinder™. We open the DA with permanent allocation so as to } { ensure that we don't take space from our code segments. } oldPerm := PermAllocation(TRUE); drvrH := GetNamedResource('DRVR', deskAccName); IF PermAllocation(oldPerm) THEN; { discard result } FailNILResource(drvrH); { Either there wasn't enough memory } { …to load the DA, or something is } { …seriously wrong. } { At this point if we are really opening a DA we know it fits in memory. } GetResInfo(drvrH, theID, theType, theName); { If it's a not a real DA then this } { will generate a ResError. } ourHeap := (HandleZone(drvrH) = ApplicZone) | OptionKeyIsDown; { Find out which zone it lives in, or if option key is down. } IF (ResError <> noErr) | { If it's a MultiFinder fake DA, } IsOpen(theID) | { …or if the DA is already open, } (NOT ourHeap) THEN { …or it's not going in our heap } BEGIN oldPerm := PermAllocation(TRUE); { In case we guess wrong } GetPort(savedPort); aRefNum := OpenDeskAcc(deskAccName); { …then go ahead and open it. } SetPort(savedPort); IF PermAllocation(oldPerm) THEN; { discard result } END ELSE BEGIN { If we get this far, we know we have a real DA and it's going into our } { heap. Open it, but them make sure we have enough memory to continue } { running. } FailSpaceIsLow; { In case we're already low on mem. } oldPerm := PermAllocation(TRUE); { If the pig wants to wallow } GetPort(savedPort); aRefNum := OpenDeskAcc(deskAccName); { Use temporary allocation. } SetPort(savedPort); IF PermAllocation(oldPerm) THEN; { discard result } FailSpaceIsLow; { Fail if not enough memory left. } FailNil(drvrH^); { …or if the driver was purged to } { …satisfy a code space requirement.} END; Success(fi); END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} PROCEDURE TApplication.OpenNew(itsCmdNumber: CmdNumber); VAR aDocument: TDocument; fi: FailInfo; newTitle: Str255; aWindow: TWindow; PROCEDURE HdlOpenNew(error: integer; message: LONGINT); BEGIN FreeIfObject(aDocument); aDocument := NIL; FailNewMessage(error, message, msgNewFailed); END; BEGIN aDocument := NIL; CatchFailures(fi, HdlOpenNew); aDocument := DoMakeDocument(KindOfDocument(itsCmdNumber, NIL)); aDocument.DoInitialState; aDocument.DoMakeViews(kForDisplay); aDocument.DoMakeWindows; aDocument.UntitledName(newTitle); { For MacApp 1.1, newTitle should be always <> '' } IF newTitle <> '' THEN aDocument.SetTitle(newTitle) ELSE IF (aDocument.fWindowList <> NIL) & (aDocument.fWindowList.GetSize > 0) THEN { Grope, grope, grope } BEGIN { must set fTitle field anyways } aWindow := TWindow(aDocument.fWindowList.First); aWindow.GetTitle(newTitle); Handle(aDocument.fTitle) := DisposeIfHandle(aDocument.fTitle); aDocument.fTitle := NewString(Copy(newTitle, aWindow.fPreDocname, length(newTitle) - aWindow.fConstTitle)); FailNil(aDocument.fTitle); END; AddDocument(aDocument); FailSpaceIsLow; { Fail if document leaves us with no room } { Don't attempt to show the windows until we're sure we won't fail } aDocument.ShowWindows; Success(fi); END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} PROCEDURE TApplication.OpenOld(itsOpenCmd: CmdNumber; anAppFile: AppFile); { Called for opening a document, given its name } VAR aDocument: TDocument; otherDoc: TDocument; oldCodeReserve, oldMemReserve: Size; fi: FailInfo; PROCEDURE HdlOpenOld(error: integer; message: LONGINT); BEGIN FreeIfObject(aDocument); aDocument := NIL; IF message = 0 THEN gErrorParm3 := anAppFile.fName; { Set the reserve back to where it was } SetReserveSize(oldCodeReserve, oldMemReserve); FailNewMessage(error, message, msgOpenFailed); END; BEGIN aDocument := NIL; CatchFailures(fi, HdlOpenOld); { Set reserve down a little to ensure that we can open existing documents } GetReserveSize(oldCodeReserve, oldMemReserve); SetReserveSize(oldCodeReserve, oldMemReserve DIV 2); otherDoc := AlreadyOpen(anAppFile.fName, anAppFile.vRefnum); IF otherDoc <> NIL THEN otherDoc.OpenAgain(itsOpenCmd, aDocument); aDocument := DoMakeDocument(KindOfDocument(itsOpenCmd, @anAppFile)); aDocument.ReadFromFile(anAppFile, kForDisplay); aDocument.DoMakeViews(kForDisplay); aDocument.DoMakeWindows; AddDocument(aDocument); FailSpaceIsLow; { Fail if the document leaves us with no memory } { Set the reserve back to where it was } SetReserveSize(oldCodeReserve, oldMemReserve); { Don't attempt to show the windows until we're sure we won't fail } aDocument.ShowWindows; Success(fi); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.PerformCommand(command: TCommand); VAR fi: FailInfo; saveCmd: BOOLEAN; {$IFC qDebug} aMAName: MAName; {$ENDC} PROCEDURE HdlDoit(error: integer; message: LONGINT); VAR aCmdNumber: integer; BEGIN IF gClipClaimed THEN BEGIN SetClipView(gClipUndoView); gClipUndoView := NIL; { The newly-installed view needs to be freed also } { SwapClipViews;} { Get original back there… !!! would be nice but doesn't do right thing yet } END; aCmdNumber := command.fCmdNumber; IF command.fFreeOnCompletion THEN FreeIfObject(command); IF command = fLastCommand THEN fLastCommand := NIL; { make sure we clear our reference } FailNewMessage(error, message, BuildMessage(aCmdNumber, msgCmdErr)); END; BEGIN IF qDebug & (command = NIL) THEN ProgramBreak('NIL passed to TApplication.PerformCommand') ELSE IF qDebug & (NOT IsObject(command)) THEN { since it's possible to have passed in a freed undoable command allocated in a global variable (due to pilot error) } BEGIN IF VerboseIsobject(command) THEN; ProgramBreak('bogus object passed to TApplication.PerformCommand'); END ELSE BEGIN {$IFC qDebug} IF gIntenseDebugging THEN BEGIN command.GetClassName(aMAName); Writeln('The Command to perform: ', aMAName); PLFlush(output); END; {$ENDC} IF command.fTracksMouse THEN BEGIN {$IFC qDebug} IF gIntenseDebugging THEN IF (command <> NIL) THEN BEGIN command.GetClassName(aMAName); Writeln('Tracking Command: ', aMAName); PLFlush(output); END; {$ENDC} IF gEventLevel = 1 THEN { Don't unload segs if in nested event handling } UnloadAllSegments; command := TrackMouse(command.fInitialPt, gStdHysteresis, command); END; IF (command <> NIL) THEN BEGIN saveCmd := command.fCausesChange | command.fCanUndo; IF saveCmd THEN BEGIN CommitLastCommand; { it frees fLastCommand. If the last (fCausesChange or fCanUndo) command sets fFreeOnCompletion to FALSE then we can execute the same undoable command any number of times. Non-Undoable commands don't get FREEd here but immediately after they're executed (that's performed… not shot) } IF qDebug & NOT IsObject(command) THEN BEGIN IF VerboseIsobject(command) THEN; ProgramBreak('You may not want to continue with a command that''s been _FREED_!' ); END; END; CatchFailures(fi, HdlDoit); IF gEventLevel = 1 THEN { Don't unload segs if in nested event handling } UnloadAllSegments; gClipClaimed := FALSE; command.DoIt; Success(fi); IF saveCmd THEN BEGIN fLastCommand := command; command.fCmdDone := TRUE; END; WITH command DO IF fCausesChange THEN { put this after .DoIt, so .DoIt can change this flag } BEGIN IF fChangedDocument <> NIL THEN WITH fChangedDocument DO SetChangeCount(Max(GetChangeCount + 1, 1)); { protect from rollover (it goes negative). If your document has this many changes (over 2 billion you are truly sick!} END; IF NOT saveCmd & command.fFreeOnCompletion THEN FreeIfObject(command); END; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.PollEvent(allowApplicationToSleep: BOOLEAN); LABEL 1000; VAR fi: FailInfo; theEvent: EventRecord; aWindow: TWindow; commandToPerform: TCommand; waitTicks: LONGINT; idledBeforeEventCall: BOOLEAN; PROCEDURE HdlPollEvt(error: integer; message: LONGINT); BEGIN {$IFC qDebug} Writeln; { add a blank line after all the messages from Failure } {$ENDC} gEventLevel := gEventLevel - 1; IF gEventLevel = 0 THEN BEGIN IF error <> noErr THEN BEGIN UnloadAllSegments; ShowError(error, message); END; HiliteMenu(0); { Make sure menus get straightened out. } InvalidateMenus; GOTO 1000; { Keep the application running. } END; END; BEGIN gEventLevel := gEventLevel + 1; {$IFC qDebug} IF gTarget = NIL THEN Writeln('Serious Error!!! in TApplication.PollEvent: target = NIL'); {$ENDC} CatchFailures(fi, HdlPollEvt); { IF we have any queued commands that have not otherwise been taken care of, now is the time. } commandToPerform := GetNextCommand; IF commandToPerform <> NIL THEN PerformCommand(commandToPerform) ELSE BEGIN { If we're running with WaitNextEvent then if there are no events pending we should idle before calling WaitNextEvent. This is because we may not come back from WaitNextEvent for an indeterminate period of time. By idling we make sure the menu bar is correct and give the app a chance to reset the idle frequency and cursor region.} IF (qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent) & (allowApplicationToSleep & (fTicksTilNextIdle > 0)) & (NOT EventAvail(gMainEventMask, theEvent)) & (gIdlePhase = idleBegin) THEN BEGIN Idle(gIdlePhase); gIdlePhase := idleContinue; idledBeforeEventCall := TRUE; END ELSE idledBeforeEventCall := FALSE; { If the cursor region is invalid, force it's recalculation before going to WNE. It won't be calculated from idle in the WNE case unless gAlwaysTrackCursor is true. } IF (qNeedsWaitNextEvent | gConfiguration.hasWaitNextEvent) & (EmptyRgn(gCursorRgn)) THEN BEGIN IF TrackCursor THEN; END; IF allowApplicationToSleep THEN waitTicks := fTicksTilNextIdle ELSE waitTicks := 0; HiliteMenu(0); IF GetEvent(gMainEventMask, waitTicks, gCursorRgn, theEvent) THEN BEGIN IF gIdlePhase <> idleBegin THEN BEGIN Idle(idleEnd); gIdlePhase := idleBegin; END; HandleEvent(theEvent); {$IFC qDebug} gErrorParm3 := '?????'; { to prevent anyone from using old values } {$ENDC} END ELSE IF NOT idledBeforeEventCall | (fTicksTilNextIdle = 0) THEN { idle if we Neeeed to! } BEGIN Idle(gIdlePhase); gIdlePhase := idleContinue; END; END; { The desk scrap may have been changed by use of Cmd-X or Cmd-C in desk accessories. } IF gSysWindowActive THEN BEGIN CheckDeskScrap; InvalidateFocus; END; Success(fi); gEventLevel := gEventLevel - 1; IF gEventLevel = 0 THEN gInhibitNestedHandling := FALSE; { All clear } 1000: { Failure re-entry point } END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.PostCommand(command: TCommand); BEGIN fCommandQueue.Insert(command); { inserts command ordered the list } END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.PostHandleEvent(VAR theEventInfo: EventInfo); VAR sysWindowAct: BOOLEAN; perm: BOOLEAN; BEGIN IF theEventInfo.affectsMenus THEN InvalidateMenus; perm := PermAllocation(FALSE); {$IFC qDebug} IF perm THEN ProgramBreak('The permanent flag was left TRUE.'); {$ENDC} { See if a system window has been activated or deactivated. } sysWindowAct := IsDeskAccessory(FrontWindow); IF sysWindowAct <> gSysWindowActive THEN BEGIN gSysWindowActive := sysWindowAct; IF gSysWindowActive THEN { deactivating to sys window } BEGIN AboutToLoseControl(TRUE); InvalidateMenuBar; END ELSE { coming back from sys window } RegainControl(TRUE); END; END; {--------------------------------------------------------------------------------------------------} {$S MAFinder} FUNCTION TApplication.PrintDocument(anAppFile: AppFile): BOOLEAN; VAR aDocument: TDocument; aPrintHandler: TPrintHandler; proceed: BOOLEAN; fi: FailInfo; PROCEDURE HdlPrintDoc(error: integer; message: LONGINT); BEGIN FreeIfObject(aDocument); aDocument := NIL; END; BEGIN aDocument := NIL; CatchFailures(fi, HdlPrintDoc); aDocument := DoMakeDocument(KindOfDocument(cFinderPrint, @anAppFile)); aDocument.ReadFromFile(anAppFile, kForPrinting); aDocument.DoMakeViews(kForPrinting); { Note that if we are finder printing, this segment will be resident } UnloadAllSegments; aPrintHandler := aDocument.fDocPrintHandler; IF aPrintHandler <> NIL THEN BEGIN proceed := aPrintHandler.SetupForFinder; IF proceed & (aPrintHandler.Print(cFinderPrint, proceed) <> NIL) THEN {$IFC qDebug} ProgramBreak('TApplication.PrintDocument: Print return a real command.') {$ENDC} ; END ELSE BEGIN proceed := TRUE; { might as well try the next one } {$IFC qDebug} ProgramBreak('TApplication.PrintDocument: The document’s fDocPrintHandler is NIL.'); {$ENDC} END; UnloadAllSegments; Success(fi); FreeIfObject(aDocument); aDocument := NIL; UnloadAllSegments; PrintDocument := proceed; END; {--------------------------------------------------------------------------------------------------} {$S MAClipboard} PROCEDURE TApplication.ReadFromDeskScrap; LABEL 1000; VAR aViewForClipboard: TView; fi: FailInfo; PROCEDURE HdlMakeViewForAlienClipbd(error: OSErr; message: LONGINT); BEGIN aViewForClipboard := gClipOrphanage; IF message = 0 THEN message := msgImportClipFailed; ShowError(error, message); GOTO 1000; END; BEGIN CatchFailures(fi, HdlMakeViewForAlienClipbd); aViewForClipboard := MakeViewForAlienClipboard; FailNil(aViewForClipboard); Success(fi); 1000: ClaimClipboard(aViewForClipboard); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.RegainControl(checkClipboard: BOOLEAN); BEGIN ActivateBusyCursor(TRUE); IF checkClipboard THEN CheckDeskScrap; END; {--------------------------------------------------------------------------------------------------} {$S MADebug} { Debugging procedure: given an EventRecord, prints out information about the event. } PROCEDURE TApplication.ReportEvent(VAR theEvent: EventRecord); VAR ch: integer; cap: integer; aString: Str255; mods: STRING[10]; aWMgrWindow: WindowPtr; BEGIN WITH theEvent DO BEGIN WRITE('t = ', when); mods := ' '; { 1234567890 } ; IF BAND(modifiers, controlKey) <> 0 THEN mods[2] := 'C'; IF BAND(modifiers, optionKey) <> 0 THEN mods[3] := 'O'; IF BAND(modifiers, alphaLock) <> 0 THEN mods[4] := 'L'; IF BAND(modifiers, shiftKey) <> 0 THEN mods[5] := 'S'; IF BAND(modifiers, cmdKey) <> 0 THEN mods[6] := 'C'; IF BAND(modifiers, btnState) <> 0 THEN mods[7] := 'M'; IF what = activateEvt THEN IF BAND(modifiers, activeFlag) <> 0 THEN mods[8] := 'A' ELSE mods[8] := 'D'; WRITE(mods); CASE what OF nullEvent: Writeln('nullEvent '); mouseDown, mouseUp: BEGIN IF what = mouseDown THEN WRITE('mouseDown ') ELSE WRITE('mouseUp '); WRITE('@ (', where.h: 1, ', ', where.v: 1, ')'); CASE FindWindow(where, aWMgrWindow) OF inMenuBar: aString := 'inMenuBar'; inSysWindow: aString := 'inSysWindow'; inDrag: aString := 'inDrag'; inGrow: aString := 'inGrow'; inGoAway: aString := 'inGoAway'; inContent: aString := 'inContent'; inZoomIn: aString := 'inZoomIn'; inZoomOut: aString := 'inZoomOut'; OTHERWISE aString := 'Mouse clicked in an unknown place.' END; Writeln(' ': 5, aString); END; keyDown, autoKey, keyUp: BEGIN IF what = keyDown THEN WRITE('keyDown ') ELSE IF what = autoKey THEN WRITE('autoKey ') ELSE WRITE('keyUp '); ch := BAND(message, charCodeMask); cap := BSR(message, 8); IF (ch >= $20) & (ch <= $D8) & (ch <> $7F) THEN WRITE('"', chr(ch), '"') ELSE WRITE(' '); Writeln('(', ch: 1, '/', cap: 1, ')'); END; updateEvt, activateEvt: BEGIN IF what = updateEvt THEN WRITE('updateEvt ') ELSE WRITE('activateEvt '); aString := WindowPeek(message)^.titleHandle^^; Writeln('"', aString, '"'); END; diskEvt: Writeln('diskEvt ', 'd = ', LoWord(message): 1, ' e = ', HiWord(message): 1); networkEvt: BEGIN WRITE('networkEvt '); WritePtr(message); Writeln; END; driverEvt: BEGIN WrLblHexLongInt('driverEvt , message', message); Writeln; END; app1Evt: BEGIN WrLblHexLongInt('app1Evt , message', message); Writeln; END; app2Evt: BEGIN WrLblHexLongInt('app2Evt , message', message); Writeln; END; app3Evt: BEGIN WrLblHexLongInt('app3Evt , message', message); Writeln; END; app4Evt: BEGIN CASE BSR(BAND(message, $FF000000), 24) OF kSuspendOrResume: IF Odd(message) THEN WRITE('resume ') ELSE WRITE('suspend '); kMouseMovedMessage: WRITE('mouse moved '); OTHERWISE WRITE('app4Evt '); END; WrLblHexLongInt(', message', message); Writeln; END; OTHERWISE BEGIN Writeln('??? unknown = ', what: 1, ' '); WriteHexLongInt(message); END; END; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} { must be in the main segment } PROCEDURE TApplication.Run; VAR findSeg: integer; BEGIN UnloadAllSegments; FailSpaceIsLow; { make sure we have enough memory to continue } gInitialized := TRUE; { was set FALSE in InitToolBox } IF gFinderPrinting THEN BEGIN findSeg := GetSegNumber(@FinderSegProc); UnloadAllSegments; SetResidentSegment(findSeg, TRUE); HandleFinderRequest; SetResidentSegment(findSeg, FALSE); UnloadAllSegments; gEventLevel := 0; { Indicate outermost level } Close; { Close is always called when quitting app } END ELSE BEGIN LaunchClipboard; UnloadAllSegments; HandleFinderRequest; UnloadAllSegments; gEventLevel := 0; { Indicate outermost level } MainEventLoop; AboutToLoseControl(TRUE); END; {$IFC qDebug} { See if previous max. resource usage has been exceeded by the termi- nation code and resources. } CheckRsrcUsage; {$ENDC} { We must call CleanupMacApp here; if we wait to fall thru to the end of the main program, A5 has been invalidated and we can't refer to any globals. } CleanupMacApp; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.SelectWMgrWindow(aWMgrWindow: WindowPtr); BEGIN SelectWindow(aWMgrWindow); { Simply call the toolbox to select it. } gLastClickPart := inDesk; { Make sure previous mouse clicks are not } { are not considered part of a multi-click. } END; {--------------------------------------------------------------------------------------------------} {$S MAClipboard} PROCEDURE TApplication.SetClipView(clipView: TView); VAR theSuperView: TView; PROCEDURE RemoveView(aView: TView); BEGIN theSuperView.RemoveSubView(aView); END; BEGIN IF gClipWindow <> NIL THEN BEGIN IF gClipWindow.CountSubViews > 0 THEN theSuperView := TView(gClipWindow.fSubViews.First) ELSE theSuperView := gClipWindow; theSuperView.EachSubView(RemoveView); theSuperView.AddSubView(clipView); clipView.fSuperView := theSuperView; clipView.SuperViewChangedSize(gZeroVPt, kDontInvalidate); clipView.RevealTop(kDontRedraw); gClipWindow.ForceRedraw; gClipWindow.SetTarget(gClipWindow); gClipWrittenToDeskScrap := clipView = gClipOrphanage; END ELSE BEGIN {$IFC qDebug} ProgramBreak('SetClipView in absence of gClipWindow'); {$ENDC} END; clipView.ViewEnable(FALSE, kDontRedraw); {Ignore clicks while in clipboard views} gClipView := clipView; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.SetTarget(newTarget: TEvtHandler); BEGIN {$Ifc qDebug} IF newTarget = NIL THEN ProgramBreak('In TApplication.SetTarget… you''re setting the global target to nil!'); {$Endc} IF newTarget <> gTarget THEN BEGIN gTarget.InstallSelection(TRUE, FALSE); newTarget.InstallSelection(FALSE, TRUE); gTarget := newTarget; fTicksTilNextIdle := 0; { Make sure we idle ASAP because there's a new target. } InvalidateCursorRgn; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.SetUndoText(cmdDone: BOOLEAN; aCmdNumber: CmdNumber); VAR newMenuState: integer; undoName: Str255; cmdName: Str255; preCmdName: integer; constChars: integer; BEGIN IF (gUndoState <> cmdDone) | (gUndoCmd <> aCmdNumber) THEN BEGIN IF aCmdNumber = cCantUndo THEN newMenuState := bzCantUndo ELSE IF cmdDone THEN newMenuState := bzUndo ELSE newMenuState := bzRedo; GetIndString(undoName, kIDBuzzString, newMenuState); IF ParseTitleTemplate(undoName, preCmdName, constChars) THEN BEGIN IF (aCmdNumber = cNoCommand) | (aCmdNumber = cCantUndo) THEN cmdName := '' ELSE CmdToName(aCmdNumber, cmdName); IF SubstituteInTitle(undoName, cmdName, preCmdName, constChars) THEN; END; SetCmdName(cUndo, undoName); gUndoState := cmdDone; gUndoCmd := aCmdNumber; END; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.SetupTheMenus; PROCEDURE DoSetup; VAR appleMenu: MenuHandle; undoState: BOOLEAN; undoCmd: CmdNumber; aWindow: TWindow; lastCommand: TCommand; lowSpace: BOOLEAN; BEGIN IF NOT InModalMenuState THEN BEGIN {$IFC qInspector} lowSpace := MemSpaceIsLow; {$EndC} aWindow := GetActiveWindow; gGotClipType := FALSE; gTarget.DoSetupMenus; { Setup menus relevent to target chain } { Set up the menu commands that are not dependent on the target chain… } undoState := kShowCantUndo; { Set the Undo menu defaults. } undoCmd := cCantUndo; IF gSysWindowActive THEN BEGIN undoState := kShowUndo; undoCmd := cNoCommand; Enable(cUndo, TRUE); Enable(cCut, TRUE); Enable(cCopy, TRUE); Enable(cPaste, TRUE); Enable(cClear, TRUE); END ELSE BEGIN lastCommand := gTarget.GetLastCommand; IF lastCommand <> NIL THEN WITH lastCommand DO IF fCanUndo THEN BEGIN IF fCmdDone THEN undoState := kShowUndo ELSE undoState := kShowRedo; undoCmd := fCmdNumber; { Enable Undo only if the last command was not document-specific or the document changed is the current document. } Enable(cUndo, (fChangedDocument = NIL) | ((aWindow <> NIL) & (fChangedDocument = aWindow.fDocument))); END; END; SetUndoText(undoState, undoCmd); {!!! we should really just make a call to the debugger/inspector here and give them a shot at setting these up instead } {$IFC qDebug} EnableCheck(cExperimenting, TRUE, gExperimenting); EnableCheck(cReportEvt, TRUE, gReportEvt); EnableCheck(cDebugPrinting, TRUE, gDebugPrinting); EnableCheck(cReportMenuChoices, TRUE, gReportMenuChoices); EnableCheck(cIntenseDebugging, TRUE, gIntenseDebugging); Enable(cIdentifySoftware, TRUE); Enable(cEnterMacAppDebugger, TRUE); IF aWindow <> NIL THEN BEGIN Enable(cModalToggle, TRUE); SetMenuState(cModalToggle, kDebugBuzzStrings, bzMakeModal, bzMakeModeless, aWindow.fIsModal); Enable(cRefreshFrontWindow, TRUE); Enable(cDoFirstClick, TRUE); SetMenuState(cDoFirstClick, kDebugBuzzStrings, bzDoFirstClick, bzDontDoFirstClick, aWindow.fDoFirstClick); END; IF qNeedsROM128k | gConfiguration.hasROM128k THEN BEGIN Enable(cSetSysJust, TRUE); SetMenuState(cSetSysJust, kDebugBuzzStrings, bzSetRightSysJust, bzSetLeftSysJust, GetActualJustification(teJustSystem) <> teJustLeft); END; EnableCheck(cTraceSetupMenus, TRUE, gTraceSetupMenus); EnableCheck(cTraceIdle, TRUE, gTraceIdle); Enable(cDebugWind, TRUE); {$ENDC} {$IFC qInspector} Enable(cNewInspectorWindow, NOT lowSpace); {$ENDC} IF NOT gSysWindowActive THEN Enable(cPaste, gGotClipType); END; appleMenu := MAGetMenu(mApple); WITH appleMenu^^ DO IF Odd(enableFlags) = InModalState THEN BEGIN enableFlags := BXOR(enableFlags, 1); InvalidateMenuBar; END; END; BEGIN IF MenusHavePendingUpdate | MenuBarHasPendingUpdate THEN PerformMenuSetup(DoSetup); END; {--------------------------------------------------------------------------------------------------} {$S MAOpen} PROCEDURE TApplication.SFGetParms(itsCmdNumber: CmdNumber; VAR dlgID: integer; VAR where: Point; VAR fileFilter, dlgHook, filterProc: ProcPtr; typeList: TypeListHandle); VAR dlogTemplate: DialogTHndl; dialogRect: Rect; BEGIN dlgID := getDlgID; { compute the top-left location of the dialog } dlogTemplate := DialogTHndl(GetResource('DLOG', dlgID)); IF dlogTemplate <> NIL THEN BEGIN dialogRect := dlogTemplate^^.boundsRect; CenterRectOnScreen(dialogRect, TRUE, TRUE, TRUE); where := dialogRect.topLeft; END ELSE SetPt(where, 100, 100); fileFilter := NIL; dlgHook := NIL; filterProc := NIL; SetHandleSize(Handle(typeList), 4); FailMemError; typeList^^[1] := gMainFileType; END; {--------------------------------------------------------------------------------------------------} {$S MAError} PROCEDURE TApplication.ShowError(error: OSErr; message: LONGINT); BEGIN ErrorAlert(error, message); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.SpaceIsLow; VAR now: LONGINT; BEGIN IF gEventLevel = 1 THEN { Don't unload segs if nested event handling} UnloadAllSegments; { Show 'space is low' alert only after ever gLowSpaceInterval ticks. } IF (gLowSpaceInterval > 0) & (NOT gInBackground) THEN BEGIN now := TickCount; IF now > gNextSpaceMsg THEN BEGIN gInhibitNestedHandling := TRUE; { Don't tell em again from the alert } StdAlert(phSpaceIsLow); gNextSpaceMsg := now + gLowSpaceInterval; END; END; END; {--------------------------------------------------------------------------------------------------} {$S MAClipboard} PROCEDURE TApplication.SwapClipViews; VAR tempClipView: TView; BEGIN tempClipView := gClipUndoView; gClipUndoView := gClipView; IF tempClipView <> NIL THEN SetClipView(tempClipView) { Installs old Undo clipboard as current clipboard } {$IFC qDebug} ELSE ProgramBreak('SwapClipViews finds undo clipboard was NIL') {$ENDC} ; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.TrackCursor: BOOLEAN; VAR globalMouse: Point; localMouse: Point; cursorIsSet: BOOLEAN; aWMgrWindow: WindowPtr; cursorWindow: TWindow; cursorView: TView; windowVPt: VPoint; windowBounds: Rect; r: Rect; haveCursorRgn: BOOLEAN; theActiveWindow: TWindow; oldPort: GrafPtr; FUNCTION GetDesktopRect: Rect; { Returns the rgnBBox of the region representing the entire desktop (including menubar). } BEGIN {$IFC qDebug} UseTempRgn('TApplication.TrackCursor, GetDesktopRect'); {$ENDC} IF qNeedsColorQD | gConfiguration.hasColorQD THEN { gTempRgn := main screen rect } RectRgn(gTempRgn, GetMainDevice^^.gdRect) ELSE RectRgn(gTempRgn, screenBits.bounds); UnionRgn(GetGrayRgn, gTempRgn, gTempRgn); { gTempRgn := grayRgn + gTempRgn } GetDesktopRect := gTempRgn^^.rgnBBox; { return bounding box } {$IFC qDebug} DoneWithTempRgn; {$ENDC} END; PROCEDURE CalcNotClaimedRgn; { Make the region wide open less the active window. And Less Any first click windows or DA's} PROCEDURE DoToWindow(theWMgrWindow: WindowPtr); VAR aWindow: TWindow; BEGIN aWindow := WMgrToWindow(theWMgrWindow); IF (aWindow <> NIL) & (aWindow.fDoFirstClick | aWindow.fIsActive) & aWindow.IsShown THEN DiffRgn(gCursorRgn, WindowPeek(theWMgrWindow)^.contRgn, gCursorRgn); END; BEGIN IF cursorWindow <> NIL THEN WITH globalMouse DO SetRectRgn(gCursorRgn, h, v, h + 1, v + 1) ELSE BEGIN r := GetDesktopRect; RectRgn(gCursorRgn, r); EachWMgrWindowDo(DoToWindow); { make sure mouse's current location is included } {$IFC qDebug} UseTempRgn('TApplication.TrackCursor, CalcNotClaimedRgn'); {$ENDC} WITH globalMouse DO SetRectRgn(gTempRgn, h, v, h + 1, v + 1); UnionRgn(gTempRgn, gCursorRgn, gCursorRgn); {$IFC qDebug} DoneWithTempRgn; {$ENDC} END; END; BEGIN TrackCursor := FALSE; IF gInBackground THEN EXIT(TrackCursor); GetMouse(globalMouse); LocalToGlobal(globalMouse); IF PtInRgn(globalMouse, gCursorRgn) THEN BEGIN {$IFC qDebug} IF gIntenseDebugging & gTraceIdle THEN Writeln('cursor is in cursor region'); {$ENDC} IF NOT gAlwaysTrackCursor THEN EXIT(TrackCursor); END; InvalidateCursorRgn; haveCursorRgn := FALSE; cursorIsSet := FALSE; { Find out if the cursor is in a window. If it is the window must be the front window or must handle first clicks. ??? Shouldn't the cursor testing be handed off to the window!!! } theActiveWindow := GetActiveWindow; IF (FindWindow(globalMouse, aWMgrWindow) = inContent) THEN BEGIN GetPort(oldPort); SetPort(aWMgrWindow); localMouse := globalMouse; GlobalToLocal(localMouse); SetPort(oldPort); cursorWindow := WMgrToWindow(aWMgrWindow); IF (NOT PtInRgn(localMouse, aWMgrWindow^.visRgn)) | ((cursorWindow <> NIL) & (cursorWindow <> theActiveWindow) & (NOT cursorWindow.fDoFirstClick)) THEN cursorWindow := NIL; END ELSE cursorWindow := NIL; IF cursorWindow <> NIL THEN BEGIN cursorWindow.GetGlobalBounds(windowBounds); windowVPt.h := globalMouse.h - windowBounds.left; windowVPt.v := globalMouse.v - windowBounds.top; cursorView := cursorWindow.HandleCursor(windowVPt, gCursorRgn); IF cursorView <> NIL THEN BEGIN cursorIsSet := TRUE; IF NOT EmptyRgn(gCursorRgn) THEN BEGIN haveCursorRgn := TRUE; { Intersect with viewed rect } IF qDebug THEN cursorView.AssumeFocused; { Intersect with visible region } SectRgn(thePort^.visRgn, gCursorRgn, gCursorRgn); SectRgn(thePort^.clipRgn, gCursorRgn, gCursorRgn); { Convert gCursorRgn from view coords to global coords } WITH thePort^.portRect DO OffsetRgn(gCursorRgn, windowBounds.left - left, windowBounds.top - top); END; END; END; IF NOT haveCursorRgn THEN CalcNotClaimedRgn; {$IFC qDebug} IF gIntenseDebugging & gTraceIdle THEN IF gCursorRgn = NIL THEN Writeln('gCursorRgn is NIL') ELSE BEGIN HLock(Handle(gCursorRgn)); WrLblRect('gCursorRgn', gCursorRgn^^.rgnBBox); Writeln; HUnlock(Handle(gCursorRgn)); END; {$ENDC} IF NOT cursorIsSet THEN SetCursor(arrow); TrackCursor := cursorIsSet; IF NOT PtInRgn(globalMouse, gCursorRgn) THEN BEGIN IF qDebug THEN BEGIN Writeln('Whoops, cursor region was not correctly calculated.'); WrLblPt('global cursor', globalMouse); WrLblRect(' gCursorRgn^^.rgnBBox', gCursorRgn^^.rgnBBox); Writeln; ProgramBreak( 'The cursor is not in the cursor region at end of TApplication.TrackCursor!' ); END; END; END; {--------------------------------------------------------------------------------------------------} {$S MADoCommand} FUNCTION TApplication.TrackMouse(globalMouse, hysteresis: Point; theCommand: TCommand): TCommand; VAR tracker: TCommand; view: TView; scroller: TScroller; gotATracker: BOOLEAN; theQDMouse: Point; theMouse: VPoint; anchorPoint: VPoint; previousPoint: VPoint; peekEvent: EventRecord; movedOnce: BOOLEAN; amtMoved: VPoint; didMove: BOOLEAN; delta: VPoint; mouseInScroller: VPoint; didScroll: BOOLEAN; currTranslation: VPoint; viewExtent: VRect; autoscrollLimit: VRect; focusedOnDesktop: BOOLEAN; desktopPort: CGrafPort; savedPort: GrafPtr; PROCEDURE CleanUpFocus; BEGIN IF focusedOnDesktop THEN BEGIN IF qNeedsColorQD | gConfiguration.hasColorQD THEN CloseCPort(@desktopPort) ELSE ClosePort(@desktopPort); SetPort(savedPort); focusedOnDesktop := FALSE; END; END; PROCEDURE SetupFocus; BEGIN IF view <> NIL THEN BEGIN IF focusedOnDesktop THEN CleanUpFocus; IF view.Focus THEN BEGIN GetFocus(gSaveFocusRec); IF scroller <> NIL THEN BEGIN scroller.GetExtent(autoscrollLimit); currTranslation := scroller.fTranslation; END; END {$IFC qDebug} ELSE ProgramBreak('TApplication.TrackMouse: Unable to focus view.') {$ENDC} ; END ELSE BEGIN { focus on the desktop } IF NOT focusedOnDesktop THEN BEGIN GetPort(savedPort); { In case we exit still focusedOnDeskTop } IF qNeedsColorQD | gConfiguration.hasColorQD THEN OpenCPort(@desktopPort) ELSE OpenPort(@desktopPort); focusedOnDesktop := TRUE; END; CopyRgn(GetGrayRgn, desktopPort.visRgn); desktopPort.portRect := desktopPort.visRgn^^.rgnBBox; InvalidateFocus; GetFocus(gSaveFocusRec); END; END; PROCEDURE DoFocus; BEGIN {$Push} {$H-} IF (scroller <> NIL) & NOT EqualVPt(currTranslation, scroller.fTranslation) THEN {$Pop} SetupFocus ELSE SetFocus(gSaveFocusRec); END; PROCEDURE InstallTracker(newTracker: TCommand); BEGIN tracker := newTracker; gotATracker := (tracker <> NIL); IF gotATracker THEN BEGIN view := tracker.fView; scroller := tracker.fScroller; IF view <> NIL THEN view.GetExtent(viewExtent); SetupFocus; END; END; PROCEDURE FeedbackOnce(turnItOn, mouseDidMove: BOOLEAN); BEGIN IF gotATracker THEN BEGIN PenNormal; PenMode(PatXOR); tracker.TrackFeedback(anchorPoint, previousPoint, turnItOn, mouseDidMove); END; END; PROCEDURE ConstrainOnce; { ??? fold this into TrackOnce ??? } BEGIN IF gotATracker THEN BEGIN IF tracker.fViewConstrain & (view <> NIL) THEN PinVRect(viewExtent, theMouse); IF tracker.fConstrainsMouse THEN tracker.TrackConstrain(anchorPoint, previousPoint, theMouse); END; END; PROCEDURE TrackOnce(aTrackPhase: TrackPhase; didMouseMove: BOOLEAN); VAR newTracker: TCommand; BEGIN {$IFC qDebug} IF tracker = NIL THEN BEGIN ProgramBreak('In TApplication.TrackMouse: tracker = NIL'); tracker := NIL; gotATracker := FALSE; END; {$ENDC} IF gotATracker THEN BEGIN newTracker := tracker.TrackMouse(aTrackPhase, anchorPoint, previousPoint, theMouse, didMouseMove); IF newTracker <> tracker THEN BEGIN FreeIfObject(tracker); tracker := NIL; InstallTracker(newTracker); END ELSE IF (newTracker <> NIL) & (newTracker.fView <> view) THEN InstallTracker(newTracker); END; END; BEGIN focusedOnDesktop := FALSE; InstallTracker(theCommand); theQDMouse := globalMouse; IF view <> NIL THEN BEGIN GlobalToLocal(theQDMouse); view.QDToViewPt(theQDMouse, theMouse); END ELSE PtToVPt(theQDMouse, theMouse); anchorPoint := theMouse; previousPoint := theMouse; ConstrainOnce; anchorPoint := theMouse; previousPoint := theMouse; { in case Constrain changed the localPoint; guarantee that all 3 are the same on TrackPress } TrackOnce(trackPress, TRUE); previousPoint := theMouse; { in case TrackMouse changed nextPoint } FeedbackOnce(TRUE, TRUE); movedOnce := FALSE; WHILE gotATracker & NOT tracker.IsDoneTracking DO BEGIN DoFocus; GetMouse(theQDMouse); IF view <> NIL THEN view.QDToViewPt(theQDMouse, theMouse) ELSE PtToVPt(theQDMouse, theMouse); IF NOT movedOnce THEN BEGIN ConstrainOnce; { ensure that we are playing on a level field. } amtMoved := theMouse; SubVPt(anchorPoint, amtMoved); IF (Abs(amtMoved.h) >= hysteresis.h) | (Abs(amtMoved.v) >= hysteresis.v) THEN movedOnce := TRUE; END; delta := gZeroVPt; IF movedOnce | tracker.fTrackNonMovement THEN BEGIN { ??? Problems with this: delta might be non-zero but scrolling can't take place because it is pinned at the end of the view also might want some slop before scrolling ??? } IF (scroller <> NIL) & (view <> NIL) THEN BEGIN mouseInScroller := theMouse; view.LocalToWindow(mouseInScroller); scroller.WindowToLocal(mouseInScroller); IF NOT PtInVRect(mouseInScroller, autoscrollLimit) THEN BEGIN scroller.AutoScroll(mouseInScroller, delta); { Get the amount to autoscroll, if any } AddVPt(delta, theMouse); END; END; ConstrainOnce; END; didScroll := NOT EqualVPt(delta, gZeroVPt); didMove := NOT EqualVPt(previousPoint, theMouse); FeedbackOnce(FALSE, didMove | didScroll); IF didScroll THEN BEGIN tracker.AutoScroll(delta.h, delta.v); { OK, now actually do the scrolling } IF view <> NIL THEN view.Update; { Keep synchronized. ScrollDraw only invalidated } SetupFocus; { the focus changed } END; TrackOnce(trackMove, didMove); { ??? add OR didscroll ??? } previousPoint := theMouse; FeedbackOnce(TRUE, didMove | didScroll); END; DoFocus; IF NOT movedOnce THEN theMouse := previousPoint { normally same as original mouse down; we don't use anchorPoint in case someone has changed that -- it is more likely that an app would change anchorPoint than previousPoint } ELSE IF EventAvail(mUpMask + mDownMask, peekEvent) THEN BEGIN theQDMouse := peekEvent.where; IF view <> NIL THEN BEGIN GlobalToLocal(theQDMouse); view.QDToViewPt(theQDMouse, theMouse); END ELSE PtToVPt(theQDMouse, theMouse); ConstrainOnce; END; { ELSE we use the last known mouse position } FeedbackOnce(FALSE, TRUE); TrackOnce(trackRelease, TRUE); CleanUpFocus; TrackMouse := tracker; END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} PROCEDURE TApplication.UpdateAllWindows; CONST systemEventMask = app4Mask; { maybe this will be defined in the interfaces someday } VAR anEvent: EventRecord; BEGIN WHILE GetEvent(updateMask + activMask + systemEventMask, 0, NIL, anEvent) DO { SystemEvents aren't queued } HandleEvent(anEvent); END; {--------------------------------------------------------------------------------------------------} {$S MAApplicationRes} FUNCTION TApplication.WMgrToWindow(aWMgrWindow: WindowPtr): TWindow; BEGIN IF (aWMgrWindow <> NIL) & (NOT IsDeskAccessory(aWMgrWindow)) { Make an IsObject test too because some slimedog may have created a window in our world and the refcon wouldn't be an object. Since this is the only place in MacApp that we get asked to do something to a ToolBox structure where we don't _know_ that we created the structure we need to be especially careful here. ??? Perhaps in the future we should use a dictionary to make the windowPtr to TWindow association for us. } & IsObject(GetWRefCon(aWMgrWindow)) THEN WMgrToWindow := TWindow(GetWRefCon(aWMgrWindow)) ELSE WMgrToWindow := NIL; END;